{- | 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.Notebook ( -- * Exported types Notebook(..) , NotebookK , toNotebook , noNotebook , -- * Methods -- ** notebookAppendPage notebookAppendPage , -- ** notebookAppendPageMenu notebookAppendPageMenu , -- ** notebookDetachTab notebookDetachTab , -- ** notebookGetActionWidget notebookGetActionWidget , -- ** notebookGetCurrentPage notebookGetCurrentPage , -- ** notebookGetGroupName notebookGetGroupName , -- ** notebookGetMenuLabel notebookGetMenuLabel , -- ** notebookGetMenuLabelText notebookGetMenuLabelText , -- ** notebookGetNPages notebookGetNPages , -- ** notebookGetNthPage notebookGetNthPage , -- ** notebookGetScrollable notebookGetScrollable , -- ** notebookGetShowBorder notebookGetShowBorder , -- ** notebookGetShowTabs notebookGetShowTabs , -- ** notebookGetTabDetachable notebookGetTabDetachable , -- ** notebookGetTabHborder notebookGetTabHborder , -- ** notebookGetTabLabel notebookGetTabLabel , -- ** notebookGetTabLabelText notebookGetTabLabelText , -- ** notebookGetTabPos notebookGetTabPos , -- ** notebookGetTabReorderable notebookGetTabReorderable , -- ** notebookGetTabVborder notebookGetTabVborder , -- ** notebookInsertPage notebookInsertPage , -- ** notebookInsertPageMenu notebookInsertPageMenu , -- ** notebookNew notebookNew , -- ** notebookNextPage notebookNextPage , -- ** notebookPageNum notebookPageNum , -- ** notebookPopupDisable notebookPopupDisable , -- ** notebookPopupEnable notebookPopupEnable , -- ** notebookPrependPage notebookPrependPage , -- ** notebookPrependPageMenu notebookPrependPageMenu , -- ** notebookPrevPage notebookPrevPage , -- ** notebookRemovePage notebookRemovePage , -- ** notebookReorderChild notebookReorderChild , -- ** notebookSetActionWidget notebookSetActionWidget , -- ** notebookSetCurrentPage notebookSetCurrentPage , -- ** notebookSetGroupName notebookSetGroupName , -- ** notebookSetMenuLabel notebookSetMenuLabel , -- ** notebookSetMenuLabelText notebookSetMenuLabelText , -- ** notebookSetScrollable notebookSetScrollable , -- ** notebookSetShowBorder notebookSetShowBorder , -- ** notebookSetShowTabs notebookSetShowTabs , -- ** notebookSetTabDetachable notebookSetTabDetachable , -- ** notebookSetTabLabel notebookSetTabLabel , -- ** notebookSetTabLabelText notebookSetTabLabelText , -- ** notebookSetTabPos notebookSetTabPos , -- ** notebookSetTabReorderable notebookSetTabReorderable , -- * Properties -- ** EnablePopup NotebookEnablePopupPropertyInfo , constructNotebookEnablePopup , getNotebookEnablePopup , setNotebookEnablePopup , -- ** GroupName NotebookGroupNamePropertyInfo , constructNotebookGroupName , getNotebookGroupName , setNotebookGroupName , -- ** Page NotebookPagePropertyInfo , constructNotebookPage , getNotebookPage , setNotebookPage , -- ** Scrollable NotebookScrollablePropertyInfo , constructNotebookScrollable , getNotebookScrollable , setNotebookScrollable , -- ** ShowBorder NotebookShowBorderPropertyInfo , constructNotebookShowBorder , getNotebookShowBorder , setNotebookShowBorder , -- ** ShowTabs NotebookShowTabsPropertyInfo , constructNotebookShowTabs , getNotebookShowTabs , setNotebookShowTabs , -- ** TabPos NotebookTabPosPropertyInfo , constructNotebookTabPos , getNotebookTabPos , setNotebookTabPos , -- * Signals -- ** ChangeCurrentPage NotebookChangeCurrentPageCallback , NotebookChangeCurrentPageCallbackC , NotebookChangeCurrentPageSignalInfo , afterNotebookChangeCurrentPage , mkNotebookChangeCurrentPageCallback , noNotebookChangeCurrentPageCallback , notebookChangeCurrentPageCallbackWrapper, notebookChangeCurrentPageClosure , onNotebookChangeCurrentPage , -- ** CreateWindow NotebookCreateWindowCallback , NotebookCreateWindowCallbackC , NotebookCreateWindowSignalInfo , afterNotebookCreateWindow , mkNotebookCreateWindowCallback , noNotebookCreateWindowCallback , notebookCreateWindowCallbackWrapper , notebookCreateWindowClosure , onNotebookCreateWindow , -- ** FocusTab NotebookFocusTabCallback , NotebookFocusTabCallbackC , NotebookFocusTabSignalInfo , afterNotebookFocusTab , mkNotebookFocusTabCallback , noNotebookFocusTabCallback , notebookFocusTabCallbackWrapper , notebookFocusTabClosure , onNotebookFocusTab , -- ** MoveFocusOut NotebookMoveFocusOutCallback , NotebookMoveFocusOutCallbackC , NotebookMoveFocusOutSignalInfo , afterNotebookMoveFocusOut , mkNotebookMoveFocusOutCallback , noNotebookMoveFocusOutCallback , notebookMoveFocusOutCallbackWrapper , notebookMoveFocusOutClosure , onNotebookMoveFocusOut , -- ** PageAdded NotebookPageAddedCallback , NotebookPageAddedCallbackC , NotebookPageAddedSignalInfo , afterNotebookPageAdded , mkNotebookPageAddedCallback , noNotebookPageAddedCallback , notebookPageAddedCallbackWrapper , notebookPageAddedClosure , onNotebookPageAdded , -- ** PageRemoved NotebookPageRemovedCallback , NotebookPageRemovedCallbackC , NotebookPageRemovedSignalInfo , afterNotebookPageRemoved , mkNotebookPageRemovedCallback , noNotebookPageRemovedCallback , notebookPageRemovedCallbackWrapper , notebookPageRemovedClosure , onNotebookPageRemoved , -- ** PageReordered NotebookPageReorderedCallback , NotebookPageReorderedCallbackC , NotebookPageReorderedSignalInfo , afterNotebookPageReordered , mkNotebookPageReorderedCallback , noNotebookPageReorderedCallback , notebookPageReorderedCallbackWrapper , notebookPageReorderedClosure , onNotebookPageReordered , -- ** ReorderTab NotebookReorderTabCallback , NotebookReorderTabCallbackC , NotebookReorderTabSignalInfo , afterNotebookReorderTab , mkNotebookReorderTabCallback , noNotebookReorderTabCallback , notebookReorderTabCallbackWrapper , notebookReorderTabClosure , onNotebookReorderTab , -- ** SelectPage NotebookSelectPageCallback , NotebookSelectPageCallbackC , NotebookSelectPageSignalInfo , afterNotebookSelectPage , mkNotebookSelectPageCallback , noNotebookSelectPageCallback , notebookSelectPageCallbackWrapper , notebookSelectPageClosure , onNotebookSelectPage , -- ** SwitchPage NotebookSwitchPageCallback , NotebookSwitchPageCallbackC , NotebookSwitchPageSignalInfo , afterNotebookSwitchPage , mkNotebookSwitchPageCallback , noNotebookSwitchPageCallback , notebookSwitchPageCallbackWrapper , notebookSwitchPageClosure , onNotebookSwitchPage , ) 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 newtype Notebook = Notebook (ForeignPtr Notebook) foreign import ccall "gtk_notebook_get_type" c_gtk_notebook_get_type :: IO GType type instance ParentTypes Notebook = NotebookParentTypes type NotebookParentTypes = '[Container, Widget, GObject.Object, Atk.ImplementorIface, Buildable] instance GObject Notebook where gobjectIsInitiallyUnowned _ = True gobjectType _ = c_gtk_notebook_get_type class GObject o => NotebookK o instance (GObject o, IsDescendantOf Notebook o) => NotebookK o toNotebook :: NotebookK o => o -> IO Notebook toNotebook = unsafeCastTo Notebook noNotebook :: Maybe Notebook noNotebook = Nothing -- signal Notebook::change-current-page type NotebookChangeCurrentPageCallback = Int32 -> IO Bool noNotebookChangeCurrentPageCallback :: Maybe NotebookChangeCurrentPageCallback noNotebookChangeCurrentPageCallback = Nothing type NotebookChangeCurrentPageCallbackC = Ptr () -> -- object Int32 -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkNotebookChangeCurrentPageCallback :: NotebookChangeCurrentPageCallbackC -> IO (FunPtr NotebookChangeCurrentPageCallbackC) notebookChangeCurrentPageClosure :: NotebookChangeCurrentPageCallback -> IO Closure notebookChangeCurrentPageClosure cb = newCClosure =<< mkNotebookChangeCurrentPageCallback wrapped where wrapped = notebookChangeCurrentPageCallbackWrapper cb notebookChangeCurrentPageCallbackWrapper :: NotebookChangeCurrentPageCallback -> Ptr () -> Int32 -> Ptr () -> IO CInt notebookChangeCurrentPageCallbackWrapper _cb _ object _ = do result <- _cb object let result' = (fromIntegral . fromEnum) result return result' onNotebookChangeCurrentPage :: (GObject a, MonadIO m) => a -> NotebookChangeCurrentPageCallback -> m SignalHandlerId onNotebookChangeCurrentPage obj cb = liftIO $ connectNotebookChangeCurrentPage obj cb SignalConnectBefore afterNotebookChangeCurrentPage :: (GObject a, MonadIO m) => a -> NotebookChangeCurrentPageCallback -> m SignalHandlerId afterNotebookChangeCurrentPage obj cb = connectNotebookChangeCurrentPage obj cb SignalConnectAfter connectNotebookChangeCurrentPage :: (GObject a, MonadIO m) => a -> NotebookChangeCurrentPageCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookChangeCurrentPage obj cb after = liftIO $ do cb' <- mkNotebookChangeCurrentPageCallback (notebookChangeCurrentPageCallbackWrapper cb) connectSignalFunPtr obj "change-current-page" cb' after -- signal Notebook::create-window type NotebookCreateWindowCallback = Widget -> Int32 -> Int32 -> IO Notebook noNotebookCreateWindowCallback :: Maybe NotebookCreateWindowCallback noNotebookCreateWindowCallback = Nothing type NotebookCreateWindowCallbackC = Ptr () -> -- object Ptr Widget -> Int32 -> Int32 -> Ptr () -> -- user_data IO (Ptr Notebook) foreign import ccall "wrapper" mkNotebookCreateWindowCallback :: NotebookCreateWindowCallbackC -> IO (FunPtr NotebookCreateWindowCallbackC) notebookCreateWindowClosure :: NotebookCreateWindowCallback -> IO Closure notebookCreateWindowClosure cb = newCClosure =<< mkNotebookCreateWindowCallback wrapped where wrapped = notebookCreateWindowCallbackWrapper cb notebookCreateWindowCallbackWrapper :: NotebookCreateWindowCallback -> Ptr () -> Ptr Widget -> Int32 -> Int32 -> Ptr () -> IO (Ptr Notebook) notebookCreateWindowCallbackWrapper _cb _ page x y _ = do page' <- (newObject Widget) page result <- _cb page' x y let result' = unsafeManagedPtrCastPtr result return result' onNotebookCreateWindow :: (GObject a, MonadIO m) => a -> NotebookCreateWindowCallback -> m SignalHandlerId onNotebookCreateWindow obj cb = liftIO $ connectNotebookCreateWindow obj cb SignalConnectBefore afterNotebookCreateWindow :: (GObject a, MonadIO m) => a -> NotebookCreateWindowCallback -> m SignalHandlerId afterNotebookCreateWindow obj cb = connectNotebookCreateWindow obj cb SignalConnectAfter connectNotebookCreateWindow :: (GObject a, MonadIO m) => a -> NotebookCreateWindowCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookCreateWindow obj cb after = liftIO $ do cb' <- mkNotebookCreateWindowCallback (notebookCreateWindowCallbackWrapper cb) connectSignalFunPtr obj "create-window" cb' after -- signal Notebook::focus-tab type NotebookFocusTabCallback = NotebookTab -> IO Bool noNotebookFocusTabCallback :: Maybe NotebookFocusTabCallback noNotebookFocusTabCallback = Nothing type NotebookFocusTabCallbackC = Ptr () -> -- object CUInt -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkNotebookFocusTabCallback :: NotebookFocusTabCallbackC -> IO (FunPtr NotebookFocusTabCallbackC) notebookFocusTabClosure :: NotebookFocusTabCallback -> IO Closure notebookFocusTabClosure cb = newCClosure =<< mkNotebookFocusTabCallback wrapped where wrapped = notebookFocusTabCallbackWrapper cb notebookFocusTabCallbackWrapper :: NotebookFocusTabCallback -> Ptr () -> CUInt -> Ptr () -> IO CInt notebookFocusTabCallbackWrapper _cb _ object _ = do let object' = (toEnum . fromIntegral) object result <- _cb object' let result' = (fromIntegral . fromEnum) result return result' onNotebookFocusTab :: (GObject a, MonadIO m) => a -> NotebookFocusTabCallback -> m SignalHandlerId onNotebookFocusTab obj cb = liftIO $ connectNotebookFocusTab obj cb SignalConnectBefore afterNotebookFocusTab :: (GObject a, MonadIO m) => a -> NotebookFocusTabCallback -> m SignalHandlerId afterNotebookFocusTab obj cb = connectNotebookFocusTab obj cb SignalConnectAfter connectNotebookFocusTab :: (GObject a, MonadIO m) => a -> NotebookFocusTabCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookFocusTab obj cb after = liftIO $ do cb' <- mkNotebookFocusTabCallback (notebookFocusTabCallbackWrapper cb) connectSignalFunPtr obj "focus-tab" cb' after -- signal Notebook::move-focus-out type NotebookMoveFocusOutCallback = DirectionType -> IO () noNotebookMoveFocusOutCallback :: Maybe NotebookMoveFocusOutCallback noNotebookMoveFocusOutCallback = Nothing type NotebookMoveFocusOutCallbackC = Ptr () -> -- object CUInt -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkNotebookMoveFocusOutCallback :: NotebookMoveFocusOutCallbackC -> IO (FunPtr NotebookMoveFocusOutCallbackC) notebookMoveFocusOutClosure :: NotebookMoveFocusOutCallback -> IO Closure notebookMoveFocusOutClosure cb = newCClosure =<< mkNotebookMoveFocusOutCallback wrapped where wrapped = notebookMoveFocusOutCallbackWrapper cb notebookMoveFocusOutCallbackWrapper :: NotebookMoveFocusOutCallback -> Ptr () -> CUInt -> Ptr () -> IO () notebookMoveFocusOutCallbackWrapper _cb _ object _ = do let object' = (toEnum . fromIntegral) object _cb object' onNotebookMoveFocusOut :: (GObject a, MonadIO m) => a -> NotebookMoveFocusOutCallback -> m SignalHandlerId onNotebookMoveFocusOut obj cb = liftIO $ connectNotebookMoveFocusOut obj cb SignalConnectBefore afterNotebookMoveFocusOut :: (GObject a, MonadIO m) => a -> NotebookMoveFocusOutCallback -> m SignalHandlerId afterNotebookMoveFocusOut obj cb = connectNotebookMoveFocusOut obj cb SignalConnectAfter connectNotebookMoveFocusOut :: (GObject a, MonadIO m) => a -> NotebookMoveFocusOutCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookMoveFocusOut obj cb after = liftIO $ do cb' <- mkNotebookMoveFocusOutCallback (notebookMoveFocusOutCallbackWrapper cb) connectSignalFunPtr obj "move-focus-out" cb' after -- signal Notebook::page-added type NotebookPageAddedCallback = Widget -> Word32 -> IO () noNotebookPageAddedCallback :: Maybe NotebookPageAddedCallback noNotebookPageAddedCallback = Nothing type NotebookPageAddedCallbackC = Ptr () -> -- object Ptr Widget -> Word32 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkNotebookPageAddedCallback :: NotebookPageAddedCallbackC -> IO (FunPtr NotebookPageAddedCallbackC) notebookPageAddedClosure :: NotebookPageAddedCallback -> IO Closure notebookPageAddedClosure cb = newCClosure =<< mkNotebookPageAddedCallback wrapped where wrapped = notebookPageAddedCallbackWrapper cb notebookPageAddedCallbackWrapper :: NotebookPageAddedCallback -> Ptr () -> Ptr Widget -> Word32 -> Ptr () -> IO () notebookPageAddedCallbackWrapper _cb _ child page_num _ = do child' <- (newObject Widget) child _cb child' page_num onNotebookPageAdded :: (GObject a, MonadIO m) => a -> NotebookPageAddedCallback -> m SignalHandlerId onNotebookPageAdded obj cb = liftIO $ connectNotebookPageAdded obj cb SignalConnectBefore afterNotebookPageAdded :: (GObject a, MonadIO m) => a -> NotebookPageAddedCallback -> m SignalHandlerId afterNotebookPageAdded obj cb = connectNotebookPageAdded obj cb SignalConnectAfter connectNotebookPageAdded :: (GObject a, MonadIO m) => a -> NotebookPageAddedCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookPageAdded obj cb after = liftIO $ do cb' <- mkNotebookPageAddedCallback (notebookPageAddedCallbackWrapper cb) connectSignalFunPtr obj "page-added" cb' after -- signal Notebook::page-removed type NotebookPageRemovedCallback = Widget -> Word32 -> IO () noNotebookPageRemovedCallback :: Maybe NotebookPageRemovedCallback noNotebookPageRemovedCallback = Nothing type NotebookPageRemovedCallbackC = Ptr () -> -- object Ptr Widget -> Word32 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkNotebookPageRemovedCallback :: NotebookPageRemovedCallbackC -> IO (FunPtr NotebookPageRemovedCallbackC) notebookPageRemovedClosure :: NotebookPageRemovedCallback -> IO Closure notebookPageRemovedClosure cb = newCClosure =<< mkNotebookPageRemovedCallback wrapped where wrapped = notebookPageRemovedCallbackWrapper cb notebookPageRemovedCallbackWrapper :: NotebookPageRemovedCallback -> Ptr () -> Ptr Widget -> Word32 -> Ptr () -> IO () notebookPageRemovedCallbackWrapper _cb _ child page_num _ = do child' <- (newObject Widget) child _cb child' page_num onNotebookPageRemoved :: (GObject a, MonadIO m) => a -> NotebookPageRemovedCallback -> m SignalHandlerId onNotebookPageRemoved obj cb = liftIO $ connectNotebookPageRemoved obj cb SignalConnectBefore afterNotebookPageRemoved :: (GObject a, MonadIO m) => a -> NotebookPageRemovedCallback -> m SignalHandlerId afterNotebookPageRemoved obj cb = connectNotebookPageRemoved obj cb SignalConnectAfter connectNotebookPageRemoved :: (GObject a, MonadIO m) => a -> NotebookPageRemovedCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookPageRemoved obj cb after = liftIO $ do cb' <- mkNotebookPageRemovedCallback (notebookPageRemovedCallbackWrapper cb) connectSignalFunPtr obj "page-removed" cb' after -- signal Notebook::page-reordered type NotebookPageReorderedCallback = Widget -> Word32 -> IO () noNotebookPageReorderedCallback :: Maybe NotebookPageReorderedCallback noNotebookPageReorderedCallback = Nothing type NotebookPageReorderedCallbackC = Ptr () -> -- object Ptr Widget -> Word32 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkNotebookPageReorderedCallback :: NotebookPageReorderedCallbackC -> IO (FunPtr NotebookPageReorderedCallbackC) notebookPageReorderedClosure :: NotebookPageReorderedCallback -> IO Closure notebookPageReorderedClosure cb = newCClosure =<< mkNotebookPageReorderedCallback wrapped where wrapped = notebookPageReorderedCallbackWrapper cb notebookPageReorderedCallbackWrapper :: NotebookPageReorderedCallback -> Ptr () -> Ptr Widget -> Word32 -> Ptr () -> IO () notebookPageReorderedCallbackWrapper _cb _ child page_num _ = do child' <- (newObject Widget) child _cb child' page_num onNotebookPageReordered :: (GObject a, MonadIO m) => a -> NotebookPageReorderedCallback -> m SignalHandlerId onNotebookPageReordered obj cb = liftIO $ connectNotebookPageReordered obj cb SignalConnectBefore afterNotebookPageReordered :: (GObject a, MonadIO m) => a -> NotebookPageReorderedCallback -> m SignalHandlerId afterNotebookPageReordered obj cb = connectNotebookPageReordered obj cb SignalConnectAfter connectNotebookPageReordered :: (GObject a, MonadIO m) => a -> NotebookPageReorderedCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookPageReordered obj cb after = liftIO $ do cb' <- mkNotebookPageReorderedCallback (notebookPageReorderedCallbackWrapper cb) connectSignalFunPtr obj "page-reordered" cb' after -- signal Notebook::reorder-tab type NotebookReorderTabCallback = DirectionType -> Bool -> IO Bool noNotebookReorderTabCallback :: Maybe NotebookReorderTabCallback noNotebookReorderTabCallback = Nothing type NotebookReorderTabCallbackC = Ptr () -> -- object CUInt -> CInt -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkNotebookReorderTabCallback :: NotebookReorderTabCallbackC -> IO (FunPtr NotebookReorderTabCallbackC) notebookReorderTabClosure :: NotebookReorderTabCallback -> IO Closure notebookReorderTabClosure cb = newCClosure =<< mkNotebookReorderTabCallback wrapped where wrapped = notebookReorderTabCallbackWrapper cb notebookReorderTabCallbackWrapper :: NotebookReorderTabCallback -> Ptr () -> CUInt -> CInt -> Ptr () -> IO CInt notebookReorderTabCallbackWrapper _cb _ object p0 _ = do let object' = (toEnum . fromIntegral) object let p0' = (/= 0) p0 result <- _cb object' p0' let result' = (fromIntegral . fromEnum) result return result' onNotebookReorderTab :: (GObject a, MonadIO m) => a -> NotebookReorderTabCallback -> m SignalHandlerId onNotebookReorderTab obj cb = liftIO $ connectNotebookReorderTab obj cb SignalConnectBefore afterNotebookReorderTab :: (GObject a, MonadIO m) => a -> NotebookReorderTabCallback -> m SignalHandlerId afterNotebookReorderTab obj cb = connectNotebookReorderTab obj cb SignalConnectAfter connectNotebookReorderTab :: (GObject a, MonadIO m) => a -> NotebookReorderTabCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookReorderTab obj cb after = liftIO $ do cb' <- mkNotebookReorderTabCallback (notebookReorderTabCallbackWrapper cb) connectSignalFunPtr obj "reorder-tab" cb' after -- signal Notebook::select-page type NotebookSelectPageCallback = Bool -> IO Bool noNotebookSelectPageCallback :: Maybe NotebookSelectPageCallback noNotebookSelectPageCallback = Nothing type NotebookSelectPageCallbackC = Ptr () -> -- object CInt -> Ptr () -> -- user_data IO CInt foreign import ccall "wrapper" mkNotebookSelectPageCallback :: NotebookSelectPageCallbackC -> IO (FunPtr NotebookSelectPageCallbackC) notebookSelectPageClosure :: NotebookSelectPageCallback -> IO Closure notebookSelectPageClosure cb = newCClosure =<< mkNotebookSelectPageCallback wrapped where wrapped = notebookSelectPageCallbackWrapper cb notebookSelectPageCallbackWrapper :: NotebookSelectPageCallback -> Ptr () -> CInt -> Ptr () -> IO CInt notebookSelectPageCallbackWrapper _cb _ object _ = do let object' = (/= 0) object result <- _cb object' let result' = (fromIntegral . fromEnum) result return result' onNotebookSelectPage :: (GObject a, MonadIO m) => a -> NotebookSelectPageCallback -> m SignalHandlerId onNotebookSelectPage obj cb = liftIO $ connectNotebookSelectPage obj cb SignalConnectBefore afterNotebookSelectPage :: (GObject a, MonadIO m) => a -> NotebookSelectPageCallback -> m SignalHandlerId afterNotebookSelectPage obj cb = connectNotebookSelectPage obj cb SignalConnectAfter connectNotebookSelectPage :: (GObject a, MonadIO m) => a -> NotebookSelectPageCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookSelectPage obj cb after = liftIO $ do cb' <- mkNotebookSelectPageCallback (notebookSelectPageCallbackWrapper cb) connectSignalFunPtr obj "select-page" cb' after -- signal Notebook::switch-page type NotebookSwitchPageCallback = Widget -> Word32 -> IO () noNotebookSwitchPageCallback :: Maybe NotebookSwitchPageCallback noNotebookSwitchPageCallback = Nothing type NotebookSwitchPageCallbackC = Ptr () -> -- object Ptr Widget -> Word32 -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkNotebookSwitchPageCallback :: NotebookSwitchPageCallbackC -> IO (FunPtr NotebookSwitchPageCallbackC) notebookSwitchPageClosure :: NotebookSwitchPageCallback -> IO Closure notebookSwitchPageClosure cb = newCClosure =<< mkNotebookSwitchPageCallback wrapped where wrapped = notebookSwitchPageCallbackWrapper cb notebookSwitchPageCallbackWrapper :: NotebookSwitchPageCallback -> Ptr () -> Ptr Widget -> Word32 -> Ptr () -> IO () notebookSwitchPageCallbackWrapper _cb _ page page_num _ = do page' <- (newObject Widget) page _cb page' page_num onNotebookSwitchPage :: (GObject a, MonadIO m) => a -> NotebookSwitchPageCallback -> m SignalHandlerId onNotebookSwitchPage obj cb = liftIO $ connectNotebookSwitchPage obj cb SignalConnectBefore afterNotebookSwitchPage :: (GObject a, MonadIO m) => a -> NotebookSwitchPageCallback -> m SignalHandlerId afterNotebookSwitchPage obj cb = connectNotebookSwitchPage obj cb SignalConnectAfter connectNotebookSwitchPage :: (GObject a, MonadIO m) => a -> NotebookSwitchPageCallback -> SignalConnectMode -> m SignalHandlerId connectNotebookSwitchPage obj cb after = liftIO $ do cb' <- mkNotebookSwitchPageCallback (notebookSwitchPageCallbackWrapper cb) connectSignalFunPtr obj "switch-page" cb' after -- VVV Prop "enable-popup" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookEnablePopup :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookEnablePopup obj = liftIO $ getObjectPropertyBool obj "enable-popup" setNotebookEnablePopup :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookEnablePopup obj val = liftIO $ setObjectPropertyBool obj "enable-popup" val constructNotebookEnablePopup :: Bool -> IO ([Char], GValue) constructNotebookEnablePopup val = constructObjectPropertyBool "enable-popup" val data NotebookEnablePopupPropertyInfo instance AttrInfo NotebookEnablePopupPropertyInfo where type AttrAllowedOps NotebookEnablePopupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookEnablePopupPropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookEnablePopupPropertyInfo = NotebookK type AttrGetType NotebookEnablePopupPropertyInfo = Bool type AttrLabel NotebookEnablePopupPropertyInfo = "Notebook::enable-popup" attrGet _ = getNotebookEnablePopup attrSet _ = setNotebookEnablePopup attrConstruct _ = constructNotebookEnablePopup -- VVV Prop "group-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getNotebookGroupName :: (MonadIO m, NotebookK o) => o -> m T.Text getNotebookGroupName obj = liftIO $ getObjectPropertyString obj "group-name" setNotebookGroupName :: (MonadIO m, NotebookK o) => o -> T.Text -> m () setNotebookGroupName obj val = liftIO $ setObjectPropertyString obj "group-name" val constructNotebookGroupName :: T.Text -> IO ([Char], GValue) constructNotebookGroupName val = constructObjectPropertyString "group-name" val data NotebookGroupNamePropertyInfo instance AttrInfo NotebookGroupNamePropertyInfo where type AttrAllowedOps NotebookGroupNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookGroupNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint NotebookGroupNamePropertyInfo = NotebookK type AttrGetType NotebookGroupNamePropertyInfo = T.Text type AttrLabel NotebookGroupNamePropertyInfo = "Notebook::group-name" attrGet _ = getNotebookGroupName attrSet _ = setNotebookGroupName attrConstruct _ = constructNotebookGroupName -- VVV Prop "page" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getNotebookPage :: (MonadIO m, NotebookK o) => o -> m Int32 getNotebookPage obj = liftIO $ getObjectPropertyCInt obj "page" setNotebookPage :: (MonadIO m, NotebookK o) => o -> Int32 -> m () setNotebookPage obj val = liftIO $ setObjectPropertyCInt obj "page" val constructNotebookPage :: Int32 -> IO ([Char], GValue) constructNotebookPage val = constructObjectPropertyCInt "page" val data NotebookPagePropertyInfo instance AttrInfo NotebookPagePropertyInfo where type AttrAllowedOps NotebookPagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookPagePropertyInfo = (~) Int32 type AttrBaseTypeConstraint NotebookPagePropertyInfo = NotebookK type AttrGetType NotebookPagePropertyInfo = Int32 type AttrLabel NotebookPagePropertyInfo = "Notebook::page" attrGet _ = getNotebookPage attrSet _ = setNotebookPage attrConstruct _ = constructNotebookPage -- VVV Prop "scrollable" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookScrollable :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookScrollable obj = liftIO $ getObjectPropertyBool obj "scrollable" setNotebookScrollable :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookScrollable obj val = liftIO $ setObjectPropertyBool obj "scrollable" val constructNotebookScrollable :: Bool -> IO ([Char], GValue) constructNotebookScrollable val = constructObjectPropertyBool "scrollable" val data NotebookScrollablePropertyInfo instance AttrInfo NotebookScrollablePropertyInfo where type AttrAllowedOps NotebookScrollablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookScrollablePropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookScrollablePropertyInfo = NotebookK type AttrGetType NotebookScrollablePropertyInfo = Bool type AttrLabel NotebookScrollablePropertyInfo = "Notebook::scrollable" attrGet _ = getNotebookScrollable attrSet _ = setNotebookScrollable attrConstruct _ = constructNotebookScrollable -- VVV Prop "show-border" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookShowBorder :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookShowBorder obj = liftIO $ getObjectPropertyBool obj "show-border" setNotebookShowBorder :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookShowBorder obj val = liftIO $ setObjectPropertyBool obj "show-border" val constructNotebookShowBorder :: Bool -> IO ([Char], GValue) constructNotebookShowBorder val = constructObjectPropertyBool "show-border" val data NotebookShowBorderPropertyInfo instance AttrInfo NotebookShowBorderPropertyInfo where type AttrAllowedOps NotebookShowBorderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookShowBorderPropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookShowBorderPropertyInfo = NotebookK type AttrGetType NotebookShowBorderPropertyInfo = Bool type AttrLabel NotebookShowBorderPropertyInfo = "Notebook::show-border" attrGet _ = getNotebookShowBorder attrSet _ = setNotebookShowBorder attrConstruct _ = constructNotebookShowBorder -- VVV Prop "show-tabs" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getNotebookShowTabs :: (MonadIO m, NotebookK o) => o -> m Bool getNotebookShowTabs obj = liftIO $ getObjectPropertyBool obj "show-tabs" setNotebookShowTabs :: (MonadIO m, NotebookK o) => o -> Bool -> m () setNotebookShowTabs obj val = liftIO $ setObjectPropertyBool obj "show-tabs" val constructNotebookShowTabs :: Bool -> IO ([Char], GValue) constructNotebookShowTabs val = constructObjectPropertyBool "show-tabs" val data NotebookShowTabsPropertyInfo instance AttrInfo NotebookShowTabsPropertyInfo where type AttrAllowedOps NotebookShowTabsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookShowTabsPropertyInfo = (~) Bool type AttrBaseTypeConstraint NotebookShowTabsPropertyInfo = NotebookK type AttrGetType NotebookShowTabsPropertyInfo = Bool type AttrLabel NotebookShowTabsPropertyInfo = "Notebook::show-tabs" attrGet _ = getNotebookShowTabs attrSet _ = setNotebookShowTabs attrConstruct _ = constructNotebookShowTabs -- VVV Prop "tab-pos" -- Type: TInterface "Gtk" "PositionType" -- Flags: [PropertyReadable,PropertyWritable] getNotebookTabPos :: (MonadIO m, NotebookK o) => o -> m PositionType getNotebookTabPos obj = liftIO $ getObjectPropertyEnum obj "tab-pos" setNotebookTabPos :: (MonadIO m, NotebookK o) => o -> PositionType -> m () setNotebookTabPos obj val = liftIO $ setObjectPropertyEnum obj "tab-pos" val constructNotebookTabPos :: PositionType -> IO ([Char], GValue) constructNotebookTabPos val = constructObjectPropertyEnum "tab-pos" val data NotebookTabPosPropertyInfo instance AttrInfo NotebookTabPosPropertyInfo where type AttrAllowedOps NotebookTabPosPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NotebookTabPosPropertyInfo = (~) PositionType type AttrBaseTypeConstraint NotebookTabPosPropertyInfo = NotebookK type AttrGetType NotebookTabPosPropertyInfo = PositionType type AttrLabel NotebookTabPosPropertyInfo = "Notebook::tab-pos" attrGet _ = getNotebookTabPos attrSet _ = setNotebookTabPos attrConstruct _ = constructNotebookTabPos type instance AttributeList Notebook = NotebookAttributeList type NotebookAttributeList = ('[ '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("enable-popup", NotebookEnablePopupPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("group-name", NotebookGroupNamePropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("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), '("page", NotebookPagePropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("scrollable", NotebookScrollablePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-border", NotebookShowBorderPropertyInfo), '("show-tabs", NotebookShowTabsPropertyInfo), '("style", WidgetStylePropertyInfo), '("tab-pos", NotebookTabPosPropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] :: [(Symbol, *)]) data NotebookChangeCurrentPageSignalInfo instance SignalInfo NotebookChangeCurrentPageSignalInfo where type HaskellCallbackType NotebookChangeCurrentPageSignalInfo = NotebookChangeCurrentPageCallback connectSignal _ = connectNotebookChangeCurrentPage data NotebookCreateWindowSignalInfo instance SignalInfo NotebookCreateWindowSignalInfo where type HaskellCallbackType NotebookCreateWindowSignalInfo = NotebookCreateWindowCallback connectSignal _ = connectNotebookCreateWindow data NotebookFocusTabSignalInfo instance SignalInfo NotebookFocusTabSignalInfo where type HaskellCallbackType NotebookFocusTabSignalInfo = NotebookFocusTabCallback connectSignal _ = connectNotebookFocusTab data NotebookMoveFocusOutSignalInfo instance SignalInfo NotebookMoveFocusOutSignalInfo where type HaskellCallbackType NotebookMoveFocusOutSignalInfo = NotebookMoveFocusOutCallback connectSignal _ = connectNotebookMoveFocusOut data NotebookPageAddedSignalInfo instance SignalInfo NotebookPageAddedSignalInfo where type HaskellCallbackType NotebookPageAddedSignalInfo = NotebookPageAddedCallback connectSignal _ = connectNotebookPageAdded data NotebookPageRemovedSignalInfo instance SignalInfo NotebookPageRemovedSignalInfo where type HaskellCallbackType NotebookPageRemovedSignalInfo = NotebookPageRemovedCallback connectSignal _ = connectNotebookPageRemoved data NotebookPageReorderedSignalInfo instance SignalInfo NotebookPageReorderedSignalInfo where type HaskellCallbackType NotebookPageReorderedSignalInfo = NotebookPageReorderedCallback connectSignal _ = connectNotebookPageReordered data NotebookReorderTabSignalInfo instance SignalInfo NotebookReorderTabSignalInfo where type HaskellCallbackType NotebookReorderTabSignalInfo = NotebookReorderTabCallback connectSignal _ = connectNotebookReorderTab data NotebookSelectPageSignalInfo instance SignalInfo NotebookSelectPageSignalInfo where type HaskellCallbackType NotebookSelectPageSignalInfo = NotebookSelectPageCallback connectSignal _ = connectNotebookSelectPage data NotebookSwitchPageSignalInfo instance SignalInfo NotebookSwitchPageSignalInfo where type HaskellCallbackType NotebookSwitchPageSignalInfo = NotebookSwitchPageCallback connectSignal _ = connectNotebookSwitchPage type instance SignalList Notebook = NotebookSignalList type NotebookSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("add", ContainerAddSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("change-current-page", NotebookChangeCurrentPageSignalInfo), '("check-resize", ContainerCheckResizeSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("create-window", NotebookCreateWindowSignalInfo), '("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), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("focus-tab", NotebookFocusTabSignalInfo), '("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", NotebookMoveFocusOutSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("page-added", NotebookPageAddedSignalInfo), '("page-removed", NotebookPageRemovedSignalInfo), '("page-reordered", NotebookPageReorderedSignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("remove", ContainerRemoveSignalInfo), '("reorder-tab", NotebookReorderTabSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("select-page", NotebookSelectPageSignalInfo), '("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-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("switch-page", NotebookSwitchPageSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)]) -- method Notebook::new -- method type : Constructor -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TInterface "Gtk" "Notebook" -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_new" gtk_notebook_new :: IO (Ptr Notebook) notebookNew :: (MonadIO m) => m Notebook notebookNew = liftIO $ do result <- gtk_notebook_new checkUnexpectedReturnNULL "gtk_notebook_new" result result' <- (newObject Notebook) result return result' -- method Notebook::append_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_append_page" gtk_notebook_append_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- tab_label : TInterface "Gtk" "Widget" IO Int32 notebookAppendPage :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c) => a -> -- _obj b -> -- child Maybe (c) -> -- tab_label m Int32 notebookAppendPage _obj child tab_label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeTab_label <- case tab_label of Nothing -> return nullPtr Just jTab_label -> do let jTab_label' = unsafeManagedPtrCastPtr jTab_label return jTab_label' result <- gtk_notebook_append_page _obj' child' maybeTab_label touchManagedPtr _obj touchManagedPtr child whenJust tab_label touchManagedPtr return result -- method Notebook::append_page_menu -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_append_page_menu" gtk_notebook_append_page_menu :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- tab_label : TInterface "Gtk" "Widget" Ptr Widget -> -- menu_label : TInterface "Gtk" "Widget" IO Int32 notebookAppendPageMenu :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c, WidgetK d) => a -> -- _obj b -> -- child Maybe (c) -> -- tab_label Maybe (d) -> -- menu_label m Int32 notebookAppendPageMenu _obj child tab_label menu_label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeTab_label <- case tab_label of Nothing -> return nullPtr Just jTab_label -> do let jTab_label' = unsafeManagedPtrCastPtr jTab_label return jTab_label' maybeMenu_label <- case menu_label of Nothing -> return nullPtr Just jMenu_label -> do let jMenu_label' = unsafeManagedPtrCastPtr jMenu_label return jMenu_label' result <- gtk_notebook_append_page_menu _obj' child' maybeTab_label maybeMenu_label touchManagedPtr _obj touchManagedPtr child whenJust tab_label touchManagedPtr whenJust menu_label touchManagedPtr return result -- method Notebook::detach_tab -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", 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_notebook_detach_tab" gtk_notebook_detach_tab :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO () notebookDetachTab :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m () notebookDetachTab _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child gtk_notebook_detach_tab _obj' child' touchManagedPtr _obj touchManagedPtr child return () -- method Notebook::get_action_widget -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pack_type", argType = TInterface "Gtk" "PackType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pack_type", argType = TInterface "Gtk" "PackType", 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_notebook_get_action_widget" gtk_notebook_get_action_widget :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" CUInt -> -- pack_type : TInterface "Gtk" "PackType" IO (Ptr Widget) notebookGetActionWidget :: (MonadIO m, NotebookK a) => a -> -- _obj PackType -> -- pack_type m Widget notebookGetActionWidget _obj pack_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let pack_type' = (fromIntegral . fromEnum) pack_type result <- gtk_notebook_get_action_widget _obj' pack_type' checkUnexpectedReturnNULL "gtk_notebook_get_action_widget" result result' <- (newObject Widget) result touchManagedPtr _obj return result' -- method Notebook::get_current_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_current_page" gtk_notebook_get_current_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO Int32 notebookGetCurrentPage :: (MonadIO m, NotebookK a) => a -> -- _obj m Int32 notebookGetCurrentPage _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_current_page _obj' touchManagedPtr _obj return result -- method Notebook::get_group_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_group_name" gtk_notebook_get_group_name :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO CString notebookGetGroupName :: (MonadIO m, NotebookK a) => a -> -- _obj m T.Text notebookGetGroupName _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_group_name _obj' checkUnexpectedReturnNULL "gtk_notebook_get_group_name" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Notebook::get_menu_label -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", 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_notebook_get_menu_label" gtk_notebook_get_menu_label :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO (Ptr Widget) notebookGetMenuLabel :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m Widget notebookGetMenuLabel _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child result <- gtk_notebook_get_menu_label _obj' child' checkUnexpectedReturnNULL "gtk_notebook_get_menu_label" result result' <- (newObject Widget) result touchManagedPtr _obj touchManagedPtr child return result' -- method Notebook::get_menu_label_text -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_menu_label_text" gtk_notebook_get_menu_label_text :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO CString notebookGetMenuLabelText :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m T.Text notebookGetMenuLabelText _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child result <- gtk_notebook_get_menu_label_text _obj' child' checkUnexpectedReturnNULL "gtk_notebook_get_menu_label_text" result result' <- cstringToText result touchManagedPtr _obj touchManagedPtr child return result' -- method Notebook::get_n_pages -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_n_pages" gtk_notebook_get_n_pages :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO Int32 notebookGetNPages :: (MonadIO m, NotebookK a) => a -> -- _obj m Int32 notebookGetNPages _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_n_pages _obj' touchManagedPtr _obj return result -- method Notebook::get_nth_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "page_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "page_num", argType = TBasicType TInt32, 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_notebook_get_nth_page" gtk_notebook_get_nth_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Int32 -> -- page_num : TBasicType TInt32 IO (Ptr Widget) notebookGetNthPage :: (MonadIO m, NotebookK a) => a -> -- _obj Int32 -> -- page_num m Widget notebookGetNthPage _obj page_num = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_nth_page _obj' page_num checkUnexpectedReturnNULL "gtk_notebook_get_nth_page" result result' <- (newObject Widget) result touchManagedPtr _obj return result' -- method Notebook::get_scrollable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_scrollable" gtk_notebook_get_scrollable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO CInt notebookGetScrollable :: (MonadIO m, NotebookK a) => a -> -- _obj m Bool notebookGetScrollable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_scrollable _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Notebook::get_show_border -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_show_border" gtk_notebook_get_show_border :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO CInt notebookGetShowBorder :: (MonadIO m, NotebookK a) => a -> -- _obj m Bool notebookGetShowBorder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_show_border _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Notebook::get_show_tabs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_show_tabs" gtk_notebook_get_show_tabs :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO CInt notebookGetShowTabs :: (MonadIO m, NotebookK a) => a -> -- _obj m Bool notebookGetShowTabs _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_show_tabs _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Notebook::get_tab_detachable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_tab_detachable" gtk_notebook_get_tab_detachable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO CInt notebookGetTabDetachable :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m Bool notebookGetTabDetachable _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child result <- gtk_notebook_get_tab_detachable _obj' child' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr child return result' -- method Notebook::get_tab_hborder -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_tab_hborder" gtk_notebook_get_tab_hborder :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO Word16 {-# DEPRECATED notebookGetTabHborder ["(Since version 3.4)","this function returns zero"]#-} notebookGetTabHborder :: (MonadIO m, NotebookK a) => a -> -- _obj m Word16 notebookGetTabHborder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_tab_hborder _obj' touchManagedPtr _obj return result -- method Notebook::get_tab_label -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", 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_notebook_get_tab_label" gtk_notebook_get_tab_label :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO (Ptr Widget) notebookGetTabLabel :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m Widget notebookGetTabLabel _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child result <- gtk_notebook_get_tab_label _obj' child' checkUnexpectedReturnNULL "gtk_notebook_get_tab_label" result result' <- (newObject Widget) result touchManagedPtr _obj touchManagedPtr child return result' -- method Notebook::get_tab_label_text -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_tab_label_text" gtk_notebook_get_tab_label_text :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO CString notebookGetTabLabelText :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m T.Text notebookGetTabLabelText _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child result <- gtk_notebook_get_tab_label_text _obj' child' checkUnexpectedReturnNULL "gtk_notebook_get_tab_label_text" result result' <- cstringToText result touchManagedPtr _obj touchManagedPtr child return result' -- method Notebook::get_tab_pos -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "Gtk" "PositionType" -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_tab_pos" gtk_notebook_get_tab_pos :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO CUInt notebookGetTabPos :: (MonadIO m, NotebookK a) => a -> -- _obj m PositionType notebookGetTabPos _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_tab_pos _obj' let result' = (toEnum . fromIntegral) result touchManagedPtr _obj return result' -- method Notebook::get_tab_reorderable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_tab_reorderable" gtk_notebook_get_tab_reorderable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO CInt notebookGetTabReorderable :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m Bool notebookGetTabReorderable _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child result <- gtk_notebook_get_tab_reorderable _obj' child' let result' = (/= 0) result touchManagedPtr _obj touchManagedPtr child return result' -- method Notebook::get_tab_vborder -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt16 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_get_tab_vborder" gtk_notebook_get_tab_vborder :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO Word16 {-# DEPRECATED notebookGetTabVborder ["(Since version 3.4)","this function returns zero"]#-} notebookGetTabVborder :: (MonadIO m, NotebookK a) => a -> -- _obj m Word16 notebookGetTabVborder _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- gtk_notebook_get_tab_vborder _obj' touchManagedPtr _obj return result -- method Notebook::insert_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_insert_page" gtk_notebook_insert_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- tab_label : TInterface "Gtk" "Widget" Int32 -> -- position : TBasicType TInt32 IO Int32 notebookInsertPage :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c) => a -> -- _obj b -> -- child Maybe (c) -> -- tab_label Int32 -> -- position m Int32 notebookInsertPage _obj child tab_label position = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeTab_label <- case tab_label of Nothing -> return nullPtr Just jTab_label -> do let jTab_label' = unsafeManagedPtrCastPtr jTab_label return jTab_label' result <- gtk_notebook_insert_page _obj' child' maybeTab_label position touchManagedPtr _obj touchManagedPtr child whenJust tab_label touchManagedPtr return result -- method Notebook::insert_page_menu -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_insert_page_menu" gtk_notebook_insert_page_menu :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- tab_label : TInterface "Gtk" "Widget" Ptr Widget -> -- menu_label : TInterface "Gtk" "Widget" Int32 -> -- position : TBasicType TInt32 IO Int32 notebookInsertPageMenu :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c, WidgetK d) => a -> -- _obj b -> -- child Maybe (c) -> -- tab_label Maybe (d) -> -- menu_label Int32 -> -- position m Int32 notebookInsertPageMenu _obj child tab_label menu_label position = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeTab_label <- case tab_label of Nothing -> return nullPtr Just jTab_label -> do let jTab_label' = unsafeManagedPtrCastPtr jTab_label return jTab_label' maybeMenu_label <- case menu_label of Nothing -> return nullPtr Just jMenu_label -> do let jMenu_label' = unsafeManagedPtrCastPtr jMenu_label return jMenu_label' result <- gtk_notebook_insert_page_menu _obj' child' maybeTab_label maybeMenu_label position touchManagedPtr _obj touchManagedPtr child whenJust tab_label touchManagedPtr whenJust menu_label touchManagedPtr return result -- method Notebook::next_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_next_page" gtk_notebook_next_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO () notebookNextPage :: (MonadIO m, NotebookK a) => a -> -- _obj m () notebookNextPage _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_notebook_next_page _obj' touchManagedPtr _obj return () -- method Notebook::page_num -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_page_num" gtk_notebook_page_num :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" IO Int32 notebookPageNum :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child m Int32 notebookPageNum _obj child = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child result <- gtk_notebook_page_num _obj' child' touchManagedPtr _obj touchManagedPtr child return result -- method Notebook::popup_disable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_popup_disable" gtk_notebook_popup_disable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO () notebookPopupDisable :: (MonadIO m, NotebookK a) => a -> -- _obj m () notebookPopupDisable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_notebook_popup_disable _obj' touchManagedPtr _obj return () -- method Notebook::popup_enable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_popup_enable" gtk_notebook_popup_enable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO () notebookPopupEnable :: (MonadIO m, NotebookK a) => a -> -- _obj m () notebookPopupEnable _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_notebook_popup_enable _obj' touchManagedPtr _obj return () -- method Notebook::prepend_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_prepend_page" gtk_notebook_prepend_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- tab_label : TInterface "Gtk" "Widget" IO Int32 notebookPrependPage :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c) => a -> -- _obj b -> -- child Maybe (c) -> -- tab_label m Int32 notebookPrependPage _obj child tab_label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeTab_label <- case tab_label of Nothing -> return nullPtr Just jTab_label -> do let jTab_label' = unsafeManagedPtrCastPtr jTab_label return jTab_label' result <- gtk_notebook_prepend_page _obj' child' maybeTab_label touchManagedPtr _obj touchManagedPtr child whenJust tab_label touchManagedPtr return result -- method Notebook::prepend_page_menu -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_prepend_page_menu" gtk_notebook_prepend_page_menu :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- tab_label : TInterface "Gtk" "Widget" Ptr Widget -> -- menu_label : TInterface "Gtk" "Widget" IO Int32 notebookPrependPageMenu :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c, WidgetK d) => a -> -- _obj b -> -- child Maybe (c) -> -- tab_label Maybe (d) -> -- menu_label m Int32 notebookPrependPageMenu _obj child tab_label menu_label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeTab_label <- case tab_label of Nothing -> return nullPtr Just jTab_label -> do let jTab_label' = unsafeManagedPtrCastPtr jTab_label return jTab_label' maybeMenu_label <- case menu_label of Nothing -> return nullPtr Just jMenu_label -> do let jMenu_label' = unsafeManagedPtrCastPtr jMenu_label return jMenu_label' result <- gtk_notebook_prepend_page_menu _obj' child' maybeTab_label maybeMenu_label touchManagedPtr _obj touchManagedPtr child whenJust tab_label touchManagedPtr whenJust menu_label touchManagedPtr return result -- method Notebook::prev_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_prev_page" gtk_notebook_prev_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" IO () notebookPrevPage :: (MonadIO m, NotebookK a) => a -> -- _obj m () notebookPrevPage _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_notebook_prev_page _obj' touchManagedPtr _obj return () -- method Notebook::remove_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "page_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "page_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_remove_page" gtk_notebook_remove_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Int32 -> -- page_num : TBasicType TInt32 IO () notebookRemovePage :: (MonadIO m, NotebookK a) => a -> -- _obj Int32 -> -- page_num m () notebookRemovePage _obj page_num = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_notebook_remove_page _obj' page_num touchManagedPtr _obj return () -- method Notebook::reorder_child -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_reorder_child" gtk_notebook_reorder_child :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Int32 -> -- position : TBasicType TInt32 IO () notebookReorderChild :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child Int32 -> -- position m () notebookReorderChild _obj child position = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child gtk_notebook_reorder_child _obj' child' position touchManagedPtr _obj touchManagedPtr child return () -- method Notebook::set_action_widget -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pack_type", argType = TInterface "Gtk" "PackType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pack_type", argType = TInterface "Gtk" "PackType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_set_action_widget" gtk_notebook_set_action_widget :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- widget : TInterface "Gtk" "Widget" CUInt -> -- pack_type : TInterface "Gtk" "PackType" IO () notebookSetActionWidget :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- widget PackType -> -- pack_type m () notebookSetActionWidget _obj widget pack_type = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let widget' = unsafeManagedPtrCastPtr widget let pack_type' = (fromIntegral . fromEnum) pack_type gtk_notebook_set_action_widget _obj' widget' pack_type' touchManagedPtr _obj touchManagedPtr widget return () -- method Notebook::set_current_page -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "page_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "page_num", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_set_current_page" gtk_notebook_set_current_page :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Int32 -> -- page_num : TBasicType TInt32 IO () notebookSetCurrentPage :: (MonadIO m, NotebookK a) => a -> -- _obj Int32 -> -- page_num m () notebookSetCurrentPage _obj page_num = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj gtk_notebook_set_current_page _obj' page_num touchManagedPtr _obj return () -- method Notebook::set_group_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_set_group_name" gtk_notebook_set_group_name :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" CString -> -- group_name : TBasicType TUTF8 IO () notebookSetGroupName :: (MonadIO m, NotebookK a) => a -> -- _obj Maybe (T.Text) -> -- group_name m () notebookSetGroupName _obj group_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeGroup_name <- case group_name of Nothing -> return nullPtr Just jGroup_name -> do jGroup_name' <- textToCString jGroup_name return jGroup_name' gtk_notebook_set_group_name _obj' maybeGroup_name touchManagedPtr _obj freeMem maybeGroup_name return () -- method Notebook::set_menu_label -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_set_menu_label" gtk_notebook_set_menu_label :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- menu_label : TInterface "Gtk" "Widget" IO () notebookSetMenuLabel :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c) => a -> -- _obj b -> -- child Maybe (c) -> -- menu_label m () notebookSetMenuLabel _obj child menu_label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeMenu_label <- case menu_label of Nothing -> return nullPtr Just jMenu_label -> do let jMenu_label' = unsafeManagedPtrCastPtr jMenu_label return jMenu_label' gtk_notebook_set_menu_label _obj' child' maybeMenu_label touchManagedPtr _obj touchManagedPtr child whenJust menu_label touchManagedPtr return () -- method Notebook::set_menu_label_text -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "menu_text", 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_notebook_set_menu_label_text" gtk_notebook_set_menu_label_text :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" CString -> -- menu_text : TBasicType TUTF8 IO () notebookSetMenuLabelText :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child T.Text -> -- menu_text m () notebookSetMenuLabelText _obj child menu_text = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child menu_text' <- textToCString menu_text gtk_notebook_set_menu_label_text _obj' child' menu_text' touchManagedPtr _obj touchManagedPtr child freeMem menu_text' return () -- method Notebook::set_scrollable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scrollable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scrollable", 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_notebook_set_scrollable" gtk_notebook_set_scrollable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" CInt -> -- scrollable : TBasicType TBoolean IO () notebookSetScrollable :: (MonadIO m, NotebookK a) => a -> -- _obj Bool -> -- scrollable m () notebookSetScrollable _obj scrollable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let scrollable' = (fromIntegral . fromEnum) scrollable gtk_notebook_set_scrollable _obj' scrollable' touchManagedPtr _obj return () -- method Notebook::set_show_border -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_border", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_border", 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_notebook_set_show_border" gtk_notebook_set_show_border :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" CInt -> -- show_border : TBasicType TBoolean IO () notebookSetShowBorder :: (MonadIO m, NotebookK a) => a -> -- _obj Bool -> -- show_border m () notebookSetShowBorder _obj show_border = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let show_border' = (fromIntegral . fromEnum) show_border gtk_notebook_set_show_border _obj' show_border' touchManagedPtr _obj return () -- method Notebook::set_show_tabs -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_tabs", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "show_tabs", 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_notebook_set_show_tabs" gtk_notebook_set_show_tabs :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" CInt -> -- show_tabs : TBasicType TBoolean IO () notebookSetShowTabs :: (MonadIO m, NotebookK a) => a -> -- _obj Bool -> -- show_tabs m () notebookSetShowTabs _obj show_tabs = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let show_tabs' = (fromIntegral . fromEnum) show_tabs gtk_notebook_set_show_tabs _obj' show_tabs' touchManagedPtr _obj return () -- method Notebook::set_tab_detachable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detachable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detachable", 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_notebook_set_tab_detachable" gtk_notebook_set_tab_detachable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" CInt -> -- detachable : TBasicType TBoolean IO () notebookSetTabDetachable :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child Bool -> -- detachable m () notebookSetTabDetachable _obj child detachable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child let detachable' = (fromIntegral . fromEnum) detachable gtk_notebook_set_tab_detachable _obj' child' detachable' touchManagedPtr _obj touchManagedPtr child return () -- method Notebook::set_tab_label -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_label", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_set_tab_label" gtk_notebook_set_tab_label :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" Ptr Widget -> -- tab_label : TInterface "Gtk" "Widget" IO () notebookSetTabLabel :: (MonadIO m, NotebookK a, WidgetK b, WidgetK c) => a -> -- _obj b -> -- child Maybe (c) -> -- tab_label m () notebookSetTabLabel _obj child tab_label = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child maybeTab_label <- case tab_label of Nothing -> return nullPtr Just jTab_label -> do let jTab_label' = unsafeManagedPtrCastPtr jTab_label return jTab_label' gtk_notebook_set_tab_label _obj' child' maybeTab_label touchManagedPtr _obj touchManagedPtr child whenJust tab_label touchManagedPtr return () -- method Notebook::set_tab_label_text -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tab_text", 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_notebook_set_tab_label_text" gtk_notebook_set_tab_label_text :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" CString -> -- tab_text : TBasicType TUTF8 IO () notebookSetTabLabelText :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child T.Text -> -- tab_text m () notebookSetTabLabelText _obj child tab_text = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child tab_text' <- textToCString tab_text gtk_notebook_set_tab_label_text _obj' child' tab_text' touchManagedPtr _obj touchManagedPtr child freeMem tab_text' return () -- method Notebook::set_tab_pos -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TInterface "Gtk" "PositionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TInterface "Gtk" "PositionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "gtk_notebook_set_tab_pos" gtk_notebook_set_tab_pos :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" CUInt -> -- pos : TInterface "Gtk" "PositionType" IO () notebookSetTabPos :: (MonadIO m, NotebookK a) => a -> -- _obj PositionType -> -- pos m () notebookSetTabPos _obj pos = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let pos' = (fromIntegral . fromEnum) pos gtk_notebook_set_tab_pos _obj' pos' touchManagedPtr _obj return () -- method Notebook::set_tab_reorderable -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reorderable", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Notebook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reorderable", 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_notebook_set_tab_reorderable" gtk_notebook_set_tab_reorderable :: Ptr Notebook -> -- _obj : TInterface "Gtk" "Notebook" Ptr Widget -> -- child : TInterface "Gtk" "Widget" CInt -> -- reorderable : TBasicType TBoolean IO () notebookSetTabReorderable :: (MonadIO m, NotebookK a, WidgetK b) => a -> -- _obj b -> -- child Bool -> -- reorderable m () notebookSetTabReorderable _obj child reorderable = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let child' = unsafeManagedPtrCastPtr child let reorderable' = (fromIntegral . fromEnum) reorderable gtk_notebook_set_tab_reorderable _obj' child' reorderable' touchManagedPtr _obj touchManagedPtr child return ()