module Graphics.UI.Gtk.Layout.Notebook (
Notebook,
NotebookClass,
NotebookPage,
castToNotebook, gTypeNotebook,
toNotebook,
notebookNew,
notebookAppendPage,
notebookAppendPageMenu,
notebookPrependPage,
notebookPrependPageMenu,
notebookInsertPage,
notebookInsertPageMenu,
notebookRemovePage,
notebookPageNum,
notebookSetCurrentPage,
notebookNextPage,
notebookPrevPage,
notebookReorderChild,
PositionType(..),
notebookSetTabPos,
notebookGetTabPos,
notebookSetShowTabs,
notebookGetShowTabs,
notebookSetShowBorder,
notebookGetShowBorder,
notebookSetScrollable,
notebookGetScrollable,
notebookSetTabBorder,
notebookSetTabHBorder,
notebookSetTabVBorder,
notebookSetPopup,
notebookGetCurrentPage,
notebookSetMenuLabel,
notebookGetMenuLabel,
notebookSetMenuLabelText,
notebookGetMenuLabelText,
notebookGetNthPage,
notebookGetNPages,
notebookGetTabLabel,
notebookGetTabLabelText,
Packing(..), PackType(..),
notebookQueryTabLabelPacking,
notebookSetTabLabelPacking,
notebookSetHomogeneousTabs,
notebookSetTabLabel,
notebookSetTabLabelText,
notebookSetTabReorderable,
notebookGetTabReorderable,
notebookSetTabDetachable,
notebookGetTabDetachable,
notebookSetActionWidget,
notebookGetActionWidget,
notebookPage,
notebookTabPos,
notebookTabBorder,
notebookTabHborder,
notebookTabVborder,
notebookShowTabs,
notebookShowBorder,
notebookScrollable,
notebookEnablePopup,
notebookHomogeneous,
notebookCurrentPage,
notebookChildTabLabel,
notebookChildMenuLabel,
notebookChildPosition,
notebookChildTabPacking,
notebookChildTabPackType,
notebookChildDetachable,
notebookChildReorderable,
notebookChildTabExpand,
notebookChildTabFill,
notebookStyleArrowSpacing,
notebookStyleHasBackwardStepper,
notebookStyleHasForwardStepper,
notebookStyleHasSecondaryBackwardStepper,
notebookStyleHasSecondaryForwardStepper,
notebookStyleTabCurvature,
notebookStyleTabOverlap,
switchPage,
pageAdded,
pageRemoved,
pageReordered,
onSwitchPage,
afterSwitchPage
) where
import Control.Monad (liftM)
import Data.Maybe (maybe)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
import Graphics.UI.Gtk.Signals
import Graphics.UI.Gtk.Abstract.ContainerChildProperties
import Graphics.UI.Gtk.Display.Label (labelNew)
import Graphics.UI.Gtk.General.Enums (Packing(..), toPacking, fromPacking,
PackType(..), PositionType(..), DirectionType(..))
newtype NotebookPage = NotebookPage (ForeignPtr (NotebookPage))
notebookNew :: IO Notebook
notebookNew =
makeNewObject mkNotebook $
liftM (castPtr :: Ptr Widget -> Ptr Notebook) $
gtk_notebook_new
notebookAppendPage :: (NotebookClass self, WidgetClass child) => self
-> child
-> String
-> IO Int
notebookAppendPage self child tabLabel = do
tab <- labelNew (Just tabLabel)
liftM fromIntegral $
(\(Notebook arg1) (Widget arg2) (Widget arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gtk_notebook_append_page argPtr1 argPtr2 argPtr3)
(toNotebook self)
(toWidget child)
(toWidget tab)
notebookAppendPageMenu :: (NotebookClass self, WidgetClass child,
WidgetClass tabLabel, WidgetClass menuLabel) => self
-> child
-> tabLabel
-> menuLabel
-> IO Int
notebookAppendPageMenu self child tabLabel menuLabel =
liftM fromIntegral $
(\(Notebook arg1) (Widget arg2) (Widget arg3) (Widget arg4) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->withForeignPtr arg4 $ \argPtr4 ->gtk_notebook_append_page_menu argPtr1 argPtr2 argPtr3 argPtr4)
(toNotebook self)
(toWidget child)
(toWidget tabLabel)
(toWidget menuLabel)
notebookPrependPage :: (NotebookClass self, WidgetClass child) => self
-> child
-> String
-> IO Int
notebookPrependPage self child tabLabel = do
tab <- labelNew (Just tabLabel)
liftM fromIntegral $
(\(Notebook arg1) (Widget arg2) (Widget arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gtk_notebook_prepend_page argPtr1 argPtr2 argPtr3)
(toNotebook self)
(toWidget child)
(toWidget tab)
notebookPrependPageMenu :: (NotebookClass self, WidgetClass child,
WidgetClass tabLabel, WidgetClass menuLabel) => self
-> child
-> tabLabel
-> menuLabel
-> IO Int
notebookPrependPageMenu self child tabLabel menuLabel =
liftM fromIntegral $
(\(Notebook arg1) (Widget arg2) (Widget arg3) (Widget arg4) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->withForeignPtr arg4 $ \argPtr4 ->gtk_notebook_prepend_page_menu argPtr1 argPtr2 argPtr3 argPtr4)
(toNotebook self)
(toWidget child)
(toWidget tabLabel)
(toWidget menuLabel)
notebookInsertPage :: (NotebookClass self, WidgetClass child) => self
-> child
-> String
-> Int
-> IO Int
notebookInsertPage self child tabLabel position = do
tab <- labelNew (Just tabLabel)
liftM fromIntegral $
(\(Notebook arg1) (Widget arg2) (Widget arg3) arg4 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gtk_notebook_insert_page argPtr1 argPtr2 argPtr3 arg4)
(toNotebook self)
(toWidget child)
(toWidget tab)
(fromIntegral position)
notebookInsertPageMenu :: (NotebookClass self, WidgetClass child,
WidgetClass tabLabel, WidgetClass menuLabel) => self
-> child
-> tabLabel
-> menuLabel
-> Int
-> IO Int
notebookInsertPageMenu self child tabLabel menuLabel position =
liftM fromIntegral $
(\(Notebook arg1) (Widget arg2) (Widget arg3) (Widget arg4) arg5 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->withForeignPtr arg4 $ \argPtr4 ->gtk_notebook_insert_page_menu argPtr1 argPtr2 argPtr3 argPtr4 arg5)
(toNotebook self)
(toWidget child)
(toWidget tabLabel)
(toWidget menuLabel)
(fromIntegral position)
notebookRemovePage :: NotebookClass self => self
-> Int
-> IO ()
notebookRemovePage self pageNum =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_remove_page argPtr1 arg2)
(toNotebook self)
(fromIntegral pageNum)
notebookPageNum :: (NotebookClass self, WidgetClass w) => self
-> w
-> IO (Maybe Int)
notebookPageNum nb child =
liftM (\page -> if page==(1) then Nothing else Just (fromIntegral page)) $
(\(Notebook arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_page_num argPtr1 argPtr2)
(toNotebook nb)
(toWidget child)
notebookSetCurrentPage :: NotebookClass self => self
-> Int
-> IO ()
notebookSetCurrentPage self pageNum =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_current_page argPtr1 arg2)
(toNotebook self)
(fromIntegral pageNum)
notebookNextPage :: NotebookClass self => self -> IO ()
notebookNextPage self =
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_next_page argPtr1)
(toNotebook self)
notebookPrevPage :: NotebookClass self => self -> IO ()
notebookPrevPage self =
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_prev_page argPtr1)
(toNotebook self)
notebookReorderChild :: (NotebookClass self, WidgetClass child) => self
-> child
-> Int
-> IO ()
notebookReorderChild self child position =
(\(Notebook arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_reorder_child argPtr1 argPtr2 arg3)
(toNotebook self)
(toWidget child)
(fromIntegral position)
notebookSetTabPos :: NotebookClass self => self
-> PositionType
-> IO ()
notebookSetTabPos self pos =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_tab_pos argPtr1 arg2)
(toNotebook self)
((fromIntegral . fromEnum) pos)
notebookGetTabPos :: NotebookClass self => self
-> IO PositionType
notebookGetTabPos self =
liftM (toEnum . fromIntegral) $
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_tab_pos argPtr1)
(toNotebook self)
notebookSetShowTabs :: NotebookClass self => self
-> Bool
-> IO ()
notebookSetShowTabs self showTabs =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_show_tabs argPtr1 arg2)
(toNotebook self)
(fromBool showTabs)
notebookGetShowTabs :: NotebookClass self => self
-> IO Bool
notebookGetShowTabs self =
liftM toBool $
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_show_tabs argPtr1)
(toNotebook self)
notebookSetShowBorder :: NotebookClass self => self
-> Bool
-> IO ()
notebookSetShowBorder self showBorder =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_show_border argPtr1 arg2)
(toNotebook self)
(fromBool showBorder)
notebookGetShowBorder :: NotebookClass self => self
-> IO Bool
notebookGetShowBorder self =
liftM toBool $
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_show_border argPtr1)
(toNotebook self)
notebookSetScrollable :: NotebookClass self => self
-> Bool
-> IO ()
notebookSetScrollable self scrollable =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_scrollable argPtr1 arg2)
(toNotebook self)
(fromBool scrollable)
notebookGetScrollable :: NotebookClass self => self
-> IO Bool
notebookGetScrollable self =
liftM toBool $
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_scrollable argPtr1)
(toNotebook self)
notebookSetTabBorder :: NotebookClass self => self
-> Int
-> IO ()
notebookSetTabBorder self borderWidth =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_tab_border argPtr1 arg2)
(toNotebook self)
(fromIntegral borderWidth)
notebookSetTabHBorder :: NotebookClass self => self
-> Int
-> IO ()
notebookSetTabHBorder self tabHborder =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_tab_hborder argPtr1 arg2)
(toNotebook self)
(fromIntegral tabHborder)
notebookSetTabVBorder :: NotebookClass self => self
-> Int
-> IO ()
notebookSetTabVBorder self tabVborder =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_tab_vborder argPtr1 arg2)
(toNotebook self)
(fromIntegral tabVborder)
notebookSetPopup :: NotebookClass self => self -> Bool -> IO ()
notebookSetPopup self enable =
(if enable
then (\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_popup_enable argPtr1)
else (\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_popup_disable argPtr1))
(toNotebook self)
notebookGetCurrentPage :: NotebookClass self => self
-> IO Int
notebookGetCurrentPage self =
liftM fromIntegral $
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_current_page argPtr1)
(toNotebook self)
notebookSetMenuLabel :: (NotebookClass self, WidgetClass child, WidgetClass menuLabel) => self
-> child
-> Maybe menuLabel
-> IO ()
notebookSetMenuLabel self child menuLabel =
(\(Notebook arg1) (Widget arg2) (Widget arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gtk_notebook_set_menu_label argPtr1 argPtr2 argPtr3)
(toNotebook self)
(toWidget child)
(maybe (Widget nullForeignPtr) toWidget menuLabel)
notebookGetMenuLabel :: (NotebookClass self, WidgetClass child) => self
-> child
-> IO (Maybe Widget)
notebookGetMenuLabel self child =
maybeNull (makeNewObject mkWidget) $
(\(Notebook arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_get_menu_label argPtr1 argPtr2)
(toNotebook self)
(toWidget child)
notebookSetMenuLabelText :: (NotebookClass self, WidgetClass child) => self
-> child
-> String
-> IO ()
notebookSetMenuLabelText self child menuText =
withUTFString menuText $ \menuTextPtr ->
(\(Notebook arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_set_menu_label_text argPtr1 argPtr2 arg3)
(toNotebook self)
(toWidget child)
menuTextPtr
notebookGetMenuLabelText :: (NotebookClass self, WidgetClass child) => self
-> child
-> IO (Maybe String)
notebookGetMenuLabelText self child =
(\(Notebook arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_get_menu_label_text argPtr1 argPtr2)
(toNotebook self)
(toWidget child)
>>= maybePeek peekUTFString
notebookGetNthPage :: NotebookClass self => self
-> Int
-> IO (Maybe Widget)
notebookGetNthPage self pageNum =
maybeNull (makeNewObject mkWidget) $
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_nth_page argPtr1 arg2)
(toNotebook self)
(fromIntegral pageNum)
notebookGetNPages :: NotebookClass self => self -> IO Int
notebookGetNPages self =
liftM fromIntegral $
(\(Notebook arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_n_pages argPtr1)
(toNotebook self)
notebookGetTabLabel :: (NotebookClass self, WidgetClass child) => self
-> child
-> IO (Maybe Widget)
notebookGetTabLabel self child =
maybeNull (makeNewObject mkWidget) $
(\(Notebook arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_get_tab_label argPtr1 argPtr2)
(toNotebook self)
(toWidget child)
notebookGetTabLabelText :: (NotebookClass self, WidgetClass child) => self
-> child
-> IO (Maybe String)
notebookGetTabLabelText self child =
(\(Notebook arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_get_tab_label_text argPtr1 argPtr2)
(toNotebook self)
(toWidget child)
>>= maybePeek peekUTFString
notebookQueryTabLabelPacking :: (NotebookClass self, WidgetClass child) => self
-> child
-> IO (Packing,PackType)
notebookQueryTabLabelPacking self child =
alloca $ \expPtr ->
alloca $ \fillPtr ->
alloca $ \packPtr -> do
(\(Notebook arg1) (Widget arg2) arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_query_tab_label_packing argPtr1 argPtr2 arg3 arg4 arg5)
(toNotebook self)
(toWidget child)
expPtr
fillPtr
packPtr
expand <- liftM toBool $ peek expPtr
fill <- liftM toBool $ peek fillPtr
pt <- liftM (toEnum . fromIntegral) $ peek packPtr
return (toPacking expand fill, pt)
notebookSetTabLabelPacking :: (NotebookClass self, WidgetClass child) => self
-> child
-> Packing
-> PackType
-> IO ()
notebookSetTabLabelPacking self child pack packType =
(\(Notebook arg1) (Widget arg2) arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_set_tab_label_packing argPtr1 argPtr2 arg3 arg4 arg5)
(toNotebook self)
(toWidget child)
(fromBool expand)
(fromBool fill)
((fromIntegral . fromEnum) packType)
where (expand, fill) = fromPacking pack
notebookSetHomogeneousTabs :: NotebookClass self => self
-> Bool
-> IO ()
notebookSetHomogeneousTabs self homogeneous =
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_set_homogeneous_tabs argPtr1 arg2)
(toNotebook self)
(fromBool homogeneous)
notebookSetTabLabel :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel) => self
-> child
-> tabLabel
-> IO ()
notebookSetTabLabel self child tabLabel =
(\(Notebook arg1) (Widget arg2) (Widget arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gtk_notebook_set_tab_label argPtr1 argPtr2 argPtr3)
(toNotebook self)
(toWidget child)
(toWidget tabLabel)
notebookSetTabLabelText :: (NotebookClass self, WidgetClass child) => self
-> child
-> String
-> IO ()
notebookSetTabLabelText self child tabText =
withUTFString tabText $ \tabTextPtr ->
(\(Notebook arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_set_tab_label_text argPtr1 argPtr2 arg3)
(toNotebook self)
(toWidget child)
tabTextPtr
notebookSetTabReorderable :: (NotebookClass self, WidgetClass child) => self
-> child
-> Bool
-> IO ()
notebookSetTabReorderable self child reorderable =
(\(Notebook arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_set_tab_reorderable argPtr1 argPtr2 arg3)
(toNotebook self)
(toWidget child)
(fromBool reorderable)
notebookGetTabReorderable :: (NotebookClass self, WidgetClass child) => self
-> child
-> IO Bool
notebookGetTabReorderable self child = liftM toBool $
(\(Notebook arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_get_tab_reorderable argPtr1 argPtr2)
(toNotebook self)
(toWidget child)
notebookSetTabDetachable :: (NotebookClass self, WidgetClass child) => self
-> child
-> Bool
-> IO ()
notebookSetTabDetachable self child detachable =
(\(Notebook arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_set_tab_detachable argPtr1 argPtr2 arg3)
(toNotebook self)
(toWidget child)
(fromBool detachable)
notebookGetTabDetachable :: (NotebookClass self, WidgetClass child) => self
-> child
-> IO Bool
notebookGetTabDetachable self child = liftM toBool $
(\(Notebook arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_get_tab_detachable argPtr1 argPtr2)
(toNotebook self)
(toWidget child)
notebookSetActionWidget :: (NotebookClass self, WidgetClass widget) => self
-> widget
-> PackType
-> IO ()
notebookSetActionWidget self widget packType =
(\(Notebook arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_notebook_set_action_widget argPtr1 argPtr2 arg3)
(toNotebook self)
(toWidget widget)
((fromIntegral . fromEnum) packType)
notebookGetActionWidget :: NotebookClass self => self
-> PackType
-> IO (Maybe Widget)
notebookGetActionWidget self packType =
maybeNull (makeNewObject mkWidget) $
(\(Notebook arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_notebook_get_action_widget argPtr1 arg2)
(toNotebook self)
((fromIntegral . fromEnum) packType)
notebookPage :: NotebookClass self => Attr self Int
notebookPage = newAttrFromIntProperty "page"
notebookTabPos :: NotebookClass self => Attr self PositionType
notebookTabPos = newAttr
notebookGetTabPos
notebookSetTabPos
notebookTabBorder :: NotebookClass self => WriteAttr self Int
notebookTabBorder = writeAttrFromUIntProperty "tab-border"
notebookTabHborder :: NotebookClass self => Attr self Int
notebookTabHborder = newAttrFromUIntProperty "tab-hborder"
notebookTabVborder :: NotebookClass self => Attr self Int
notebookTabVborder = newAttrFromUIntProperty "tab-vborder"
notebookShowTabs :: NotebookClass self => Attr self Bool
notebookShowTabs = newAttr
notebookGetShowTabs
notebookSetShowTabs
notebookShowBorder :: NotebookClass self => Attr self Bool
notebookShowBorder = newAttr
notebookGetShowBorder
notebookSetShowBorder
notebookScrollable :: NotebookClass self => Attr self Bool
notebookScrollable = newAttr
notebookGetScrollable
notebookSetScrollable
notebookEnablePopup :: NotebookClass self => Attr self Bool
notebookEnablePopup = newAttrFromBoolProperty "enable-popup"
notebookHomogeneous :: NotebookClass self => Attr self Bool
notebookHomogeneous = newAttrFromBoolProperty "homogeneous"
notebookCurrentPage :: NotebookClass self => Attr self Int
notebookCurrentPage = newAttr
notebookGetCurrentPage
notebookSetCurrentPage
notebookChildTabLabel :: (NotebookClass self, WidgetClass child) => child -> Attr self String
notebookChildTabLabel = newAttrFromContainerChildStringProperty "tab-label"
notebookChildMenuLabel :: (NotebookClass self, WidgetClass child) => child -> Attr self String
notebookChildMenuLabel = newAttrFromContainerChildStringProperty "menu-label"
notebookChildPosition :: (NotebookClass self, WidgetClass child) => child -> Attr self Int
notebookChildPosition = newAttrFromContainerChildIntProperty "position"
notebookChildTabPacking :: (NotebookClass self, WidgetClass child) => child -> Attr self Packing
notebookChildTabPacking child = newAttr
(\container -> do
expand <- containerChildGetPropertyBool "tab-expand" child container
fill <- containerChildGetPropertyBool "tab-fill" child container
return (toPacking expand fill))
(\container packing ->
case fromPacking packing of
(expand, fill) -> do
containerChildSetPropertyBool "tab-expand" child container expand
containerChildSetPropertyBool "tab-fill" child container fill)
notebookChildTabPackType :: (NotebookClass self, WidgetClass child) => child -> Attr self PackType
notebookChildTabPackType = newAttrFromContainerChildEnumProperty "tab-pack"
gtk_pack_type_get_type
notebookChildDetachable :: NotebookClass self => Attr self Bool
notebookChildDetachable = newAttrFromBoolProperty "detachable"
notebookChildReorderable :: NotebookClass self => Attr self Bool
notebookChildReorderable = newAttrFromBoolProperty "reorderable"
notebookChildTabExpand :: NotebookClass self => Attr self Bool
notebookChildTabExpand = newAttrFromBoolProperty "tab-expand"
notebookChildTabFill :: NotebookClass self => Attr self Bool
notebookChildTabFill = newAttrFromBoolProperty "tab-fill"
notebookStyleArrowSpacing :: NotebookClass self => ReadAttr self Bool
notebookStyleArrowSpacing = readAttrFromBoolProperty "arrow-spacing"
notebookStyleHasBackwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasBackwardStepper = readAttrFromBoolProperty "has-backward-stepper"
notebookStyleHasForwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasForwardStepper = readAttrFromBoolProperty "has-forward-stepper"
notebookStyleHasSecondaryBackwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasSecondaryBackwardStepper = readAttrFromBoolProperty "has-secondary-backward-stepper"
notebookStyleHasSecondaryForwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasSecondaryForwardStepper = readAttrFromBoolProperty "has-secondary-forward-stepper"
notebookStyleTabCurvature :: NotebookClass self => ReadAttr self Int
notebookStyleTabCurvature = readAttrFromIntProperty "tab-curvature"
notebookStyleTabOverlap :: NotebookClass self => ReadAttr self Int
notebookStyleTabOverlap = readAttrFromIntProperty "tab-overlap"
switchPage :: NotebookClass self => Signal self (Int -> IO ())
switchPage = Signal (\after obj act ->
connect_PTR_WORD__NONE "switch-page" after obj
(\_ page -> act (fromIntegral page)))
pageReordered :: NotebookClass self => Signal self (Widget -> Int -> IO ())
pageReordered = Signal (connect_OBJECT_INT__NONE "page-reordered")
pageRemoved :: NotebookClass self => Signal self (Widget -> Int -> IO ())
pageRemoved = Signal (connect_OBJECT_INT__NONE "page-removed")
pageAdded :: NotebookClass self => Signal self (Widget -> Int -> IO ())
pageAdded = Signal (connect_OBJECT_INT__NONE "page-added")
onSwitchPage, afterSwitchPage :: NotebookClass nb => nb -> (Int -> IO ()) ->
IO (ConnectId nb)
onSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page"
(const $ return ()) False nb
(\_ page -> fun (fromIntegral page))
afterSwitchPage nb fun = connect_BOXED_WORD__NONE "switch-page"
(const $ return ()) True nb
(\_ page -> fun (fromIntegral page))
foreign import ccall unsafe "gtk_notebook_new"
gtk_notebook_new :: (IO (Ptr Widget))
foreign import ccall safe "gtk_notebook_append_page"
gtk_notebook_append_page :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> (IO CInt))))
foreign import ccall safe "gtk_notebook_append_page_menu"
gtk_notebook_append_page_menu :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> ((Ptr Widget) -> (IO CInt)))))
foreign import ccall safe "gtk_notebook_prepend_page"
gtk_notebook_prepend_page :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> (IO CInt))))
foreign import ccall safe "gtk_notebook_prepend_page_menu"
gtk_notebook_prepend_page_menu :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> ((Ptr Widget) -> (IO CInt)))))
foreign import ccall safe "gtk_notebook_insert_page"
gtk_notebook_insert_page :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> (CInt -> (IO CInt)))))
foreign import ccall safe "gtk_notebook_insert_page_menu"
gtk_notebook_insert_page_menu :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> ((Ptr Widget) -> (CInt -> (IO CInt))))))
foreign import ccall safe "gtk_notebook_remove_page"
gtk_notebook_remove_page :: ((Ptr Notebook) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_notebook_page_num"
gtk_notebook_page_num :: ((Ptr Notebook) -> ((Ptr Widget) -> (IO CInt)))
foreign import ccall safe "gtk_notebook_set_current_page"
gtk_notebook_set_current_page :: ((Ptr Notebook) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_notebook_next_page"
gtk_notebook_next_page :: ((Ptr Notebook) -> (IO ()))
foreign import ccall safe "gtk_notebook_prev_page"
gtk_notebook_prev_page :: ((Ptr Notebook) -> (IO ()))
foreign import ccall safe "gtk_notebook_reorder_child"
gtk_notebook_reorder_child :: ((Ptr Notebook) -> ((Ptr Widget) -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_notebook_set_tab_pos"
gtk_notebook_set_tab_pos :: ((Ptr Notebook) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_notebook_get_tab_pos"
gtk_notebook_get_tab_pos :: ((Ptr Notebook) -> (IO CInt))
foreign import ccall safe "gtk_notebook_set_show_tabs"
gtk_notebook_set_show_tabs :: ((Ptr Notebook) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_notebook_get_show_tabs"
gtk_notebook_get_show_tabs :: ((Ptr Notebook) -> (IO CInt))
foreign import ccall safe "gtk_notebook_set_show_border"
gtk_notebook_set_show_border :: ((Ptr Notebook) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_notebook_get_show_border"
gtk_notebook_get_show_border :: ((Ptr Notebook) -> (IO CInt))
foreign import ccall unsafe "gtk_notebook_set_scrollable"
gtk_notebook_set_scrollable :: ((Ptr Notebook) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_notebook_get_scrollable"
gtk_notebook_get_scrollable :: ((Ptr Notebook) -> (IO CInt))
foreign import ccall safe "gtk_notebook_set_tab_border"
gtk_notebook_set_tab_border :: ((Ptr Notebook) -> (CUInt -> (IO ())))
foreign import ccall safe "gtk_notebook_set_tab_hborder"
gtk_notebook_set_tab_hborder :: ((Ptr Notebook) -> (CUInt -> (IO ())))
foreign import ccall safe "gtk_notebook_set_tab_vborder"
gtk_notebook_set_tab_vborder :: ((Ptr Notebook) -> (CUInt -> (IO ())))
foreign import ccall safe "gtk_notebook_popup_enable"
gtk_notebook_popup_enable :: ((Ptr Notebook) -> (IO ()))
foreign import ccall safe "gtk_notebook_popup_disable"
gtk_notebook_popup_disable :: ((Ptr Notebook) -> (IO ()))
foreign import ccall unsafe "gtk_notebook_get_current_page"
gtk_notebook_get_current_page :: ((Ptr Notebook) -> (IO CInt))
foreign import ccall safe "gtk_notebook_set_menu_label"
gtk_notebook_set_menu_label :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> (IO ()))))
foreign import ccall unsafe "gtk_notebook_get_menu_label"
gtk_notebook_get_menu_label :: ((Ptr Notebook) -> ((Ptr Widget) -> (IO (Ptr Widget))))
foreign import ccall safe "gtk_notebook_set_menu_label_text"
gtk_notebook_set_menu_label_text :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr CChar) -> (IO ()))))
foreign import ccall unsafe "gtk_notebook_get_menu_label_text"
gtk_notebook_get_menu_label_text :: ((Ptr Notebook) -> ((Ptr Widget) -> (IO (Ptr CChar))))
foreign import ccall unsafe "gtk_notebook_get_nth_page"
gtk_notebook_get_nth_page :: ((Ptr Notebook) -> (CInt -> (IO (Ptr Widget))))
foreign import ccall unsafe "gtk_notebook_get_n_pages"
gtk_notebook_get_n_pages :: ((Ptr Notebook) -> (IO CInt))
foreign import ccall unsafe "gtk_notebook_get_tab_label"
gtk_notebook_get_tab_label :: ((Ptr Notebook) -> ((Ptr Widget) -> (IO (Ptr Widget))))
foreign import ccall unsafe "gtk_notebook_get_tab_label_text"
gtk_notebook_get_tab_label_text :: ((Ptr Notebook) -> ((Ptr Widget) -> (IO (Ptr CChar))))
foreign import ccall unsafe "gtk_notebook_query_tab_label_packing"
gtk_notebook_query_tab_label_packing :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))))
foreign import ccall safe "gtk_notebook_set_tab_label_packing"
gtk_notebook_set_tab_label_packing :: ((Ptr Notebook) -> ((Ptr Widget) -> (CInt -> (CInt -> (CInt -> (IO ()))))))
foreign import ccall safe "gtk_notebook_set_homogeneous_tabs"
gtk_notebook_set_homogeneous_tabs :: ((Ptr Notebook) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_notebook_set_tab_label"
gtk_notebook_set_tab_label :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr Widget) -> (IO ()))))
foreign import ccall safe "gtk_notebook_set_tab_label_text"
gtk_notebook_set_tab_label_text :: ((Ptr Notebook) -> ((Ptr Widget) -> ((Ptr CChar) -> (IO ()))))
foreign import ccall safe "gtk_notebook_set_tab_reorderable"
gtk_notebook_set_tab_reorderable :: ((Ptr Notebook) -> ((Ptr Widget) -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_notebook_get_tab_reorderable"
gtk_notebook_get_tab_reorderable :: ((Ptr Notebook) -> ((Ptr Widget) -> (IO CInt)))
foreign import ccall safe "gtk_notebook_set_tab_detachable"
gtk_notebook_set_tab_detachable :: ((Ptr Notebook) -> ((Ptr Widget) -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_notebook_get_tab_detachable"
gtk_notebook_get_tab_detachable :: ((Ptr Notebook) -> ((Ptr Widget) -> (IO CInt)))
foreign import ccall safe "gtk_notebook_set_action_widget"
gtk_notebook_set_action_widget :: ((Ptr Notebook) -> ((Ptr Widget) -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_notebook_get_action_widget"
gtk_notebook_get_action_widget :: ((Ptr Notebook) -> (CInt -> (IO (Ptr Widget))))
foreign import ccall unsafe "gtk_pack_type_get_type"
gtk_pack_type_get_type :: CUInt