{-# LINE 2 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Notebook
--
-- Author : Axel Simon, Andy Stewart
--
-- Created: 15 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
-- Copyright (C) 2009 Andy Stewart
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- TODO
--
-- Functions:
-- gtk_notebook_set_group
-- gtk_notebook_get_group
-- gtk_notebook_set_window_creation_hook
-- Attributes:
-- group
-- Signals:
-- focusTab
--
-- NOTE
--
-- Don't binding `group-id` attribute, even set/get_group_id functions is deprecated)
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- A tabbed notebook container
--
module Graphics.UI.Gtk.Layout.Notebook (
-- * Detail
--
-- | The 'Notebook' widget is a 'Container' whose children are pages that can
-- be switched between using tab labels along one edge.
--
-- There are many configuration options for 'Notebook'. Among other things,
-- you can choose on which edge the tabs appear (see 'notebookSetTabPos'),
-- whether, if there are too many tabs to fit the noteobook should be made
-- bigger or scrolling arrows added (see 'notebookSetScrollable'), and
-- whether there will be a popup menu allowing the users to switch pages. (see
-- 'notebookEnablePopup')

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----Notebook
-- @

-- * Types
  Notebook,
  NotebookClass,



  castToNotebook, gTypeNotebook,
  toNotebook,

-- * Constructors
  notebookNew,

-- * Methods
  notebookAppendPage,
  notebookAppendPageMenu,
  notebookPrependPage,
  notebookPrependPageMenu,
  notebookInsertPage,
  notebookInsertPageMenu,
  notebookRemovePage,
  notebookPageNum,
  notebookSetCurrentPage,
  notebookNextPage,
  notebookPrevPage,
  notebookReorderChild,
  PositionType(..),
  notebookSetTabPos,
  notebookGetTabPos,
  notebookSetShowTabs,
  notebookGetShowTabs,
  notebookSetShowBorder,
  notebookGetShowBorder,
  notebookSetScrollable,
  notebookGetScrollable,







  notebookSetPopup,
  notebookGetCurrentPage,
  notebookSetMenuLabel,
  notebookGetMenuLabel,
  notebookSetMenuLabelText,
  notebookGetMenuLabelText,
  notebookGetNthPage,

  notebookGetNPages,

  notebookGetTabLabel,
  notebookGetTabLabelText,
  Packing(..), PackType(..),







  notebookSetTabLabel,
  notebookSetTabLabelText,

  notebookSetTabReorderable,
  notebookGetTabReorderable,
  notebookSetTabDetachable,
  notebookGetTabDetachable,


  notebookSetActionWidget,
  notebookGetActionWidget,


-- * Attributes
  notebookPage,
  notebookTabPos,
  notebookTabBorder,
  notebookTabHborder,
  notebookTabVborder,
  notebookShowTabs,
  notebookShowBorder,
  notebookScrollable,
  notebookEnablePopup,
  notebookHomogeneous,
  notebookCurrentPage,

-- * Child Attributes
  notebookChildTabLabel,
  notebookChildMenuLabel,
  notebookChildPosition,
  notebookChildTabPacking,
  notebookChildTabPackType,
  notebookChildDetachable,
  notebookChildReorderable,
  notebookChildTabExpand,
  notebookChildTabFill,

-- * Style Attributes

  notebookStyleArrowSpacing,

  notebookStyleHasBackwardStepper,
  notebookStyleHasForwardStepper,
  notebookStyleHasSecondaryBackwardStepper,
  notebookStyleHasSecondaryForwardStepper,

  notebookStyleTabCurvature,
  notebookStyleTabOverlap,


-- * Signals
  switchPage,
  pageAdded,
  pageRemoved,
  pageReordered,

-- * Deprecated




  ) where

import Control.Monad (liftM)

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
{-# LINE 199 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 200 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
import Graphics.UI.Gtk.Abstract.ContainerChildProperties
import Graphics.UI.Gtk.Display.Label (labelNew)
import Graphics.UI.Gtk.General.Enums (Packing(..), toPacking, fromPacking,
                                         PackType(..), PositionType(..))


{-# LINE 206 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}






--------------------
-- Constructors

-- | Creates a new 'Notebook' widget with no pages.
--
notebookNew :: IO Notebook
notebookNew :: IO Notebook
notebookNew =
  (ForeignPtr Notebook -> Notebook, FinalizerPtr Notebook)
-> IO (Ptr Notebook) -> IO Notebook
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Notebook -> Notebook, FinalizerPtr Notebook)
forall {a}. (ForeignPtr Notebook -> Notebook, FinalizerPtr a)
mkNotebook (IO (Ptr Notebook) -> IO Notebook)
-> IO (Ptr Notebook) -> IO Notebook
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Notebook)
-> IO (Ptr Widget) -> IO (Ptr Notebook)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Notebook
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Notebook) (IO (Ptr Widget) -> IO (Ptr Notebook))
-> IO (Ptr Widget) -> IO (Ptr Notebook)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_notebook_new
{-# LINE 222 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}

--------------------
-- Methods


-- | Appends a page to @notebook@.
--
-- The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu.
-- If you want to specify something else to go in the tab, use
-- 'notebookAppendPageMenu'.
--
-- * This function returned @()@ in Gtk+ version 2.2.X and earlier
--
notebookAppendPage :: (NotebookClass self, WidgetClass child, GlibString string) => self
 -> child -- ^ @child@ - the 'Widget' to use as the contents of the page.
 -> string -- ^ @tabLabel@ - the label for the page
 -> IO Int -- ^ returns the index (starting from 0) of the appended page in
             -- the notebook, or -1 if function fails
notebookAppendPage :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
self -> child -> string -> IO Int
notebookAppendPage self
self child
child string
tabLabel = do
  Label
tab <- Maybe string -> IO Label
forall string. GlibString string => Maybe string -> IO Label
labelNew (string -> Maybe string
forall a. a -> Maybe a
Just string
tabLabel)
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
   (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->Ptr Notebook -> Ptr Widget -> Ptr Widget -> IO CInt
gtk_notebook_append_page Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3)
{-# LINE 245 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (Label -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Label
tab)
{-# LINE 272 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Appends a page to @notebook@, specifying the widget to use as the label
-- in the popup menu.
--
-- Like 'notebookAppendPage' but allows any widget to be used for the label of
-- the new tab and the entry in the page-switch popup menu.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookAppendPageMenu :: (NotebookClass self, WidgetClass child,
  WidgetClass tabLabel, WidgetClass menuLabel) => self
 -> child -- ^ @child@ - the 'Widget' to use as the contents of the page.
 -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the
              -- page (usually a 'Label' widget).
 -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the
              -- page-switch menu, if that is enabled (usually a 'Label'
              -- widget).
 -> IO Int -- ^ returns the index (starting from 0) of the appended page in
              -- the notebook, or -1 if function fails
notebookAppendPageMenu :: forall self child tabLabel menuLabel.
(NotebookClass self, WidgetClass child, WidgetClass tabLabel,
 WidgetClass menuLabel) =>
self -> child -> tabLabel -> menuLabel -> IO Int
notebookAppendPageMenu self
self child
child tabLabel
tabLabel menuLabel
menuLabel =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) (Widget ForeignPtr Widget
arg4) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg4 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr4 ->Ptr Notebook -> Ptr Widget -> Ptr Widget -> Ptr Widget -> IO CInt
gtk_notebook_append_page_menu Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3 Ptr Widget
argPtr4)
{-# LINE 293 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (tabLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget tabLabel
tabLabel)
    (menuLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget menuLabel
menuLabel)
{-# LINE 325 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Prepends a page to @notebook@.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookPrependPageMenu'.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPage :: (NotebookClass self, WidgetClass child, GlibString string) => self
 -> child -- ^ @child@ - the 'Widget' to use as the contents of the page.
 -> string -- ^ @tabLabel@ - the label for the page
 -> IO Int -- ^ returns the index (starting from 0) of the prepended page in
             -- the notebook, or -1 if function fails
notebookPrependPage :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
self -> child -> string -> IO Int
notebookPrependPage self
self child
child string
tabLabel = do
  Label
tab <- Maybe string -> IO Label
forall string. GlibString string => Maybe string -> IO Label
labelNew (string -> Maybe string
forall a. a -> Maybe a
Just string
tabLabel)
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
   (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->Ptr Notebook -> Ptr Widget -> Ptr Widget -> IO CInt
gtk_notebook_prepend_page Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3)
{-# LINE 343 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (Label -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Label
tab)
{-# LINE 370 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Prepends a page to @notebook@, specifying the widget to use as the label
-- in the popup menu.
--
-- Like 'notebookPrependPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookPrependPageMenu :: (NotebookClass self, WidgetClass child,
 WidgetClass tabLabel, WidgetClass menuLabel) => self
 -> child -- ^ @child@ - the 'Widget' to use as the contents of the page.
 -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the
              -- page (usually a 'Label' widget).
 -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the
              -- page-switch menu, if that is enabled (usually a 'Label'
              -- widget).
 -> IO Int -- ^ returns the index (starting from 0) of the prepended page
              -- in the notebook, or -1 if function fails
notebookPrependPageMenu :: forall self child tabLabel menuLabel.
(NotebookClass self, WidgetClass child, WidgetClass tabLabel,
 WidgetClass menuLabel) =>
self -> child -> tabLabel -> menuLabel -> IO Int
notebookPrependPageMenu self
self child
child tabLabel
tabLabel menuLabel
menuLabel =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) (Widget ForeignPtr Widget
arg4) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg4 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr4 ->Ptr Notebook -> Ptr Widget -> Ptr Widget -> Ptr Widget -> IO CInt
gtk_notebook_prepend_page_menu Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3 Ptr Widget
argPtr4)
{-# LINE 391 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (tabLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget tabLabel
tabLabel)
    (menuLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget menuLabel
menuLabel)
{-# LINE 422 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Insert a page into @notebook@ at the given position.
--
-- * The given label will be used for the label widget of the new tab. In case
-- the context menu is enabled, this name will also appear in the popup menu. If
-- you want to specify something else to go in the tab, use
-- 'notebookInsertPageMenu'.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPage :: (NotebookClass self, WidgetClass child, GlibString string) => self
 -> child -- ^ @child@ - the 'Widget' to use as the contents of the page.
 -> string -- ^ @tabLabel@ - the label for the page
 -> Int -- ^ @position@ - the index (starting at 0) at which to insert
             -- the page, or -1 to append the page after all other pages.
 -> IO Int -- ^ returns the index (starting from 0) of the inserted page in
             -- the notebook, or -1 if function fails
notebookInsertPage :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
self -> child -> string -> Int -> IO Int
notebookInsertPage self
self child
child string
tabLabel Int
position = do
  Label
tab <- Maybe string -> IO Label
forall string. GlibString string => Maybe string -> IO Label
labelNew (string -> Maybe string
forall a. a -> Maybe a
Just string
tabLabel)
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
   (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) CInt
arg4 -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->Ptr Notebook -> Ptr Widget -> Ptr Widget -> CInt -> IO CInt
gtk_notebook_insert_page Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3 CInt
arg4)
{-# LINE 442 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (Label -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Label
tab)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
{-# LINE 473 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Insert a page into @notebook@ at the given position, specifying the
-- widget to use as the label in the popup menu.
--
-- Like 'notebookInsertPage' but allows any widget to be used for the label of
-- the new tab and then entry in the page-switch popup menu.
--
-- * This function returned @()@ in Gtk version 2.2.X and earlier
--
notebookInsertPageMenu :: (NotebookClass self, WidgetClass child,
 WidgetClass tabLabel, WidgetClass menuLabel) => self
 -> child -- ^ @child@ - the 'Widget' to use as the contents of the page.
 -> tabLabel -- ^ @tabLabel@ - the 'Widget' to be used as the label for the
              -- page (usually a 'Label' widget).
 -> menuLabel -- ^ @menuLabel@ - the widget to use as a label for the
              -- page-switch menu, if that is enabled (usually a 'Label'
              -- widget).
 -> Int -- ^ @position@ - the index (starting at 0) at which to insert
              -- the page, or -1 to append the page after all other pages.
 -> IO Int -- ^ returns the index (starting from 0) of the inserted page in
              -- the notebook, or -1 if function fails
notebookInsertPageMenu :: forall self child tabLabel menuLabel.
(NotebookClass self, WidgetClass child, WidgetClass tabLabel,
 WidgetClass menuLabel) =>
self -> child -> tabLabel -> menuLabel -> Int -> IO Int
notebookInsertPageMenu self
self child
child tabLabel
tabLabel menuLabel
menuLabel Int
position =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) (Widget ForeignPtr Widget
arg4) CInt
arg5 -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg4 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr4 ->Ptr Notebook
-> Ptr Widget -> Ptr Widget -> Ptr Widget -> CInt -> IO CInt
gtk_notebook_insert_page_menu Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3 Ptr Widget
argPtr4 CInt
arg5)
{-# LINE 496 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (tabLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget tabLabel
tabLabel)
    (menuLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget menuLabel
menuLabel)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
{-# LINE 526 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Removes a page from the notebook given its index in the notebook.
--
notebookRemovePage :: NotebookClass self => self
 -> Int -- ^ @pageNum@ - the index of a notebook page, starting from 0. If
          -- -1, the last page will be removed.
 -> IO ()
notebookRemovePage :: forall self. NotebookClass self => self -> Int -> IO ()
notebookRemovePage self
self Int
pageNum =
  (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO ()
gtk_notebook_remove_page Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 534 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pageNum)

-- | Query the page the child widget is contained in.
--
-- * The function returns the page number if the child was found, Nothing
-- otherwise.
--
notebookPageNum :: (NotebookClass self, WidgetClass w) => self
 -> w
 -> IO (Maybe Int)
notebookPageNum :: forall self w.
(NotebookClass self, WidgetClass w) =>
self -> w -> IO (Maybe Int)
notebookPageNum self
nb w
child =
  (CInt -> Maybe Int) -> IO CInt -> IO (Maybe Int)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\CInt
page -> if CInt
pageCInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==(-CInt
1) then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
page)) (IO CInt -> IO (Maybe Int)) -> IO CInt -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> IO CInt
gtk_notebook_page_num Ptr Notebook
argPtr1 Ptr Widget
argPtr2)
{-# LINE 548 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook nb)
    (w -> Widget
forall o. WidgetClass o => o -> Widget
toWidget w
child)

-- | Switches to the page number @pageNum@. Page numbers start from @0@.
-- Use @-1@ to request the last page.
--
-- * Note that due to historical reasons, GtkNotebook refuses
-- to switch to a page unless the child widget is visible.
-- Therefore, it is recommended to show child widgets before
-- adding them to a notebook.
--
notebookSetCurrentPage :: NotebookClass self => self
 -> Int -- ^ @pageNum@ - index of the page to switch to, starting from 0. If
          -- negative, the last page will be used. If greater than the number
          -- of pages in the notebook, nothing will be done.
 -> IO ()
notebookSetCurrentPage :: forall self. NotebookClass self => self -> Int -> IO ()
notebookSetCurrentPage self
self Int
pageNum =
  (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO ()
gtk_notebook_set_current_page Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 566 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pageNum)

-- | Switches to the next page. Nothing happens if the current page is the
-- last page.
--
notebookNextPage :: NotebookClass self => self -> IO ()
notebookNextPage :: forall self. NotebookClass self => self -> IO ()
notebookNextPage self
self =
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO ()
gtk_notebook_next_page Ptr Notebook
argPtr1)
{-# LINE 575 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)

-- | Switches to the previous page. Nothing happens if the current page is the
-- first page.
--
notebookPrevPage :: NotebookClass self => self -> IO ()
notebookPrevPage :: forall self. NotebookClass self => self -> IO ()
notebookPrevPage self
self =
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO ()
gtk_notebook_prev_page Ptr Notebook
argPtr1)
{-# LINE 583 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)

-- | Reorders the page containing @child@, so that it appears in position
-- @position@. If @position@ is greater than or equal to the number of children
-- in the list or negative, @child@ will be moved to the end of the list.
--
notebookReorderChild :: (NotebookClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the child to move
 -> Int -- ^ @position@ - the new position, or -1 to move to the end
 -> IO ()
notebookReorderChild :: forall self child.
(NotebookClass self, WidgetClass child) =>
self -> child -> Int -> IO ()
notebookReorderChild self
self child
child Int
position =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> CInt -> IO ()
gtk_notebook_reorder_child Ptr Notebook
argPtr1 Ptr Widget
argPtr2 CInt
arg3)
{-# LINE 595 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)

-- | Sets the edge at which the tabs for switching pages in the notebook are
-- drawn.
--
notebookSetTabPos :: NotebookClass self => self
 -> PositionType -- ^ @pos@ - the edge to draw the tabs at.
 -> IO ()
notebookSetTabPos :: forall self. NotebookClass self => self -> PositionType -> IO ()
notebookSetTabPos self
self PositionType
pos =
  (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO ()
gtk_notebook_set_tab_pos Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 607 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PositionType -> Int) -> PositionType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionType -> Int
forall a. Enum a => a -> Int
fromEnum) PositionType
pos)

-- | Gets the edge at which the tabs for switching pages in the notebook are
-- drawn.
--
notebookGetTabPos :: NotebookClass self => self
 -> IO PositionType -- ^ returns the edge at which the tabs are drawn
notebookGetTabPos :: forall self. NotebookClass self => self -> IO PositionType
notebookGetTabPos self
self =
  (CInt -> PositionType) -> IO CInt -> IO PositionType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PositionType
forall a. Enum a => Int -> a
toEnum (Int -> PositionType) -> (CInt -> Int) -> CInt -> PositionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO PositionType) -> IO CInt -> IO PositionType
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO CInt
gtk_notebook_get_tab_pos Ptr Notebook
argPtr1)
{-# LINE 618 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)

-- | Sets whether to show the tabs for the notebook or not.
--
notebookSetShowTabs :: NotebookClass self => self
 -> Bool -- ^ @showTabs@ - @True@ if the tabs should be shown.
 -> IO ()
notebookSetShowTabs :: forall self. NotebookClass self => self -> Bool -> IO ()
notebookSetShowTabs self
self Bool
showTabs =
  (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO ()
gtk_notebook_set_show_tabs Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 627 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
showTabs)

-- | Returns whether the tabs of the notebook are shown. See
-- 'notebookSetShowTabs'.
--
notebookGetShowTabs :: NotebookClass self => self
 -> IO Bool -- ^ returns @True@ if the tabs are shown
notebookGetShowTabs :: forall self. NotebookClass self => self -> IO Bool
notebookGetShowTabs self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO CInt
gtk_notebook_get_show_tabs Ptr Notebook
argPtr1)
{-# LINE 638 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)

-- | Sets whether a bevel will be drawn around the notebook pages. This only
-- has a visual effect when the tabs are not shown. See 'notebookSetShowTabs'.
--
notebookSetShowBorder :: NotebookClass self => self
 -> Bool -- ^ @showBorder@ - @True@ if a bevel should be drawn around the
          -- notebook.
 -> IO ()
notebookSetShowBorder :: forall self. NotebookClass self => self -> Bool -> IO ()
notebookSetShowBorder self
self Bool
showBorder =
  (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO ()
gtk_notebook_set_show_border Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 649 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
showBorder)

-- | Returns whether a bevel will be drawn around the notebook pages. See
-- 'notebookSetShowBorder'.
--
notebookGetShowBorder :: NotebookClass self => self
 -> IO Bool -- ^ returns @True@ if the bevel is drawn
notebookGetShowBorder :: forall self. NotebookClass self => self -> IO Bool
notebookGetShowBorder self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO CInt
gtk_notebook_get_show_border Ptr Notebook
argPtr1)
{-# LINE 660 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)

-- | Sets whether the tab label area will have arrows for scrolling if there
-- are too many tabs to fit in the area.
--
notebookSetScrollable :: NotebookClass self => self
 -> Bool -- ^ @scrollable@ - @True@ if scroll arrows should be added
 -> IO ()
notebookSetScrollable :: forall self. NotebookClass self => self -> Bool -> IO ()
notebookSetScrollable self
self Bool
scrollable =
  (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO ()
gtk_notebook_set_scrollable Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 670 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
scrollable)

-- | Returns whether the tab label area has arrows for scrolling. See
-- 'notebookSetScrollable'.
--
notebookGetScrollable :: NotebookClass self => self
 -> IO Bool -- ^ returns @True@ if arrows for scrolling are present
notebookGetScrollable :: forall self. NotebookClass self => self -> IO Bool
notebookGetScrollable self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO CInt
gtk_notebook_get_scrollable Ptr Notebook
argPtr1)
{-# LINE 681 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
{-# LINE 731 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Enables or disables the popup menu: if the user clicks with the right
-- mouse button on the bookmarks, a menu with all the pages will be popped up.
--
notebookSetPopup :: NotebookClass self => self -> Bool -> IO ()
notebookSetPopup :: forall self. NotebookClass self => self -> Bool -> IO ()
notebookSetPopup self
self Bool
enable =
  (if Bool
enable
     then (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO ()
gtk_notebook_popup_enable Ptr Notebook
argPtr1)
{-# LINE 738 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
     else (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO ()
gtk_notebook_popup_disable Ptr Notebook
argPtr1))
    (self -> Notebook
forall o. NotebookClass o => o -> Notebook
toNotebook self
self)

-- | Returns the page number of the current page.
--
notebookGetCurrentPage :: NotebookClass self => self
 -> IO Int -- ^ returns the index (starting from 0) of the current page in the
           -- notebook. If the notebook has no pages, then -1 will be returned.
notebookGetCurrentPage :: forall self. NotebookClass self => self -> IO Int
notebookGetCurrentPage self
self =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO CInt
gtk_notebook_get_current_page Ptr Notebook
argPtr1)
{-# LINE 749 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)

-- | Changes the menu label for the page containing @child@.
--
notebookSetMenuLabel :: (NotebookClass self, WidgetClass child, WidgetClass menuLabel) => self
 -> child -- ^ @child@ - the child widget
 -> Maybe menuLabel -- ^ @menuLabel@ - the menu label, or @Nothing@ for
                    -- default
 -> IO ()
notebookSetMenuLabel :: forall self child menuLabel.
(NotebookClass self, WidgetClass child, WidgetClass menuLabel) =>
self -> child -> Maybe menuLabel -> IO ()
notebookSetMenuLabel self
self child
child Maybe menuLabel
menuLabel =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->Ptr Notebook -> Ptr Widget -> Ptr Widget -> IO ()
gtk_notebook_set_menu_label Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3)
{-# LINE 760 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (Widget -> (menuLabel -> Widget) -> Maybe menuLabel -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) menuLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe menuLabel
menuLabel)

-- | Retrieves the menu label widget of the page containing @child@.
--
notebookGetMenuLabel :: (NotebookClass self, WidgetClass child) => self
 -> child -- ^ @child@ - a widget contained in a page of
                      -- @notebook@
 -> IO (Maybe Widget) -- ^ returns the menu label, or @Nothing@ if the
                      -- notebook page does not have a menu label other than
                      -- the default (the tab label).
notebookGetMenuLabel :: forall self child.
(NotebookClass self, WidgetClass child) =>
self -> child -> IO (Maybe Widget)
notebookGetMenuLabel self
self child
child =
  (IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget) (IO (Ptr Widget) -> IO (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Notebook
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget
-> (Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> IO (Ptr Widget)
gtk_notebook_get_menu_label Ptr Notebook
argPtr1 Ptr Widget
argPtr2)
{-# LINE 775 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)

-- | Creates a new label and sets it as the menu label of @child@.
--
notebookSetMenuLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self
 -> child -- ^ @child@ - the child widget
 -> string -- ^ @menuText@ - the label text
 -> IO ()
notebookSetMenuLabelText :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
self -> child -> string -> IO ()
notebookSetMenuLabelText self
self child
child string
menuText =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
menuText ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
menuTextPtr ->
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) CString
arg3 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> CString -> IO ()
gtk_notebook_set_menu_label_text Ptr Notebook
argPtr1 Ptr Widget
argPtr2 CString
arg3)
{-# LINE 787 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    CString
menuTextPtr

-- | Retrieves the text of the menu label for the page containing @child@.
--
notebookGetMenuLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self
 -> child -- ^ @child@ - the child widget of a page of the
                      -- notebook.
 -> IO (Maybe string) -- ^ returns value: the text of the tab label, or
                      -- @Nothing@ if the widget does not have a menu label
                      -- other than the default menu label, or the menu label
                      -- widget is not a 'Label'.
notebookGetMenuLabelText :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
self -> child -> IO (Maybe string)
notebookGetMenuLabelText self
self child
child =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CString) -> IO CString)
-> (Ptr Notebook -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CString) -> IO CString)
-> (Ptr Widget -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> IO CString
gtk_notebook_get_menu_label_text Ptr Notebook
argPtr1 Ptr Widget
argPtr2)
{-# LINE 802 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
  IO CString -> (CString -> IO (Maybe string)) -> IO (Maybe string)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO string) -> CString -> IO (Maybe string)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString

-- | Returns the child widget contained in page number @pageNum@.
--
notebookGetNthPage :: NotebookClass self => self
 -> Int -- ^ @pageNum@ - the index of a page in the noteobok, or
                      -- -1 to get the last page.
 -> IO (Maybe Widget) -- ^ returns the child widget, or @Nothing@ if @pageNum@
                      -- is out of bounds.
notebookGetNthPage :: forall self. NotebookClass self => self -> Int -> IO (Maybe Widget)
notebookGetNthPage self
self Int
pageNum =
  (IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget) (IO (Ptr Widget) -> IO (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO (Ptr Widget)
gtk_notebook_get_nth_page Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 816 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pageNum)


-- | Gets the number of pages in a notebook.
--
-- * Available since Gtk version 2.2
--
notebookGetNPages :: NotebookClass self => self -> IO Int
notebookGetNPages :: forall self. NotebookClass self => self -> IO Int
notebookGetNPages self
self =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> IO CInt
gtk_notebook_get_n_pages Ptr Notebook
argPtr1)
{-# LINE 828 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)


-- | Returns the tab label widget for the page @child@. @Nothing@ is returned
-- if @child@ is not in @notebook@ or if no tab label has specifically been set
-- for @child@.
--
notebookGetTabLabel :: (NotebookClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the page
 -> IO (Maybe Widget) -- ^ returns the tab label
notebookGetTabLabel :: forall self child.
(NotebookClass self, WidgetClass child) =>
self -> child -> IO (Maybe Widget)
notebookGetTabLabel self
self child
child =
  (IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget) (IO (Ptr Widget) -> IO (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Notebook
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget
-> (Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> IO (Ptr Widget)
gtk_notebook_get_tab_label Ptr Notebook
argPtr1 Ptr Widget
argPtr2)
{-# LINE 841 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)

-- | Retrieves the text of the tab label for the page containing @child@.
--
notebookGetTabLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self
 -> child -- ^ @child@ - a widget contained in a page of
                      -- @notebook@
 -> IO (Maybe string) -- ^ returns value: the text of the tab label, or
                      -- @Nothing@ if the tab label widget is not a 'Label'.
notebookGetTabLabelText :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
self -> child -> IO (Maybe string)
notebookGetTabLabelText self
self child
child =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CString) -> IO CString)
-> (Ptr Notebook -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CString) -> IO CString)
-> (Ptr Widget -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> IO CString
gtk_notebook_get_tab_label_text Ptr Notebook
argPtr1 Ptr Widget
argPtr2)
{-# LINE 853 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
  IO CString -> (CString -> IO (Maybe string)) -> IO (Maybe string)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO string) -> CString -> IO (Maybe string)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString
{-# LINE 916 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
-- | Changes the tab label for @child@.
--
notebookSetTabLabel :: (NotebookClass self, WidgetClass child, WidgetClass tabLabel) => self
 -> child -- ^ @child@ - the page
 -> tabLabel -- ^ @tabLabel@ - the tab label widget to use
 -> IO ()
notebookSetTabLabel :: forall self child tabLabel.
(NotebookClass self, WidgetClass child, WidgetClass tabLabel) =>
self -> child -> tabLabel -> IO ()
notebookSetTabLabel self
self child
child tabLabel
tabLabel =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) (Widget ForeignPtr Widget
arg3) -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg3 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr3 ->Ptr Notebook -> Ptr Widget -> Ptr Widget -> IO ()
gtk_notebook_set_tab_label Ptr Notebook
argPtr1 Ptr Widget
argPtr2 Ptr Widget
argPtr3)
{-# LINE 924 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (tabLabel -> Widget
forall o. WidgetClass o => o -> Widget
toWidget tabLabel
tabLabel)

-- | Creates a new label and sets it as the tab label for the page containing
-- @child@.
--
notebookSetTabLabelText :: (NotebookClass self, WidgetClass child, GlibString string) => self
 -> child -- ^ @child@ - the page
 -> string -- ^ @tabText@ - the label text
 -> IO ()
notebookSetTabLabelText :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
self -> child -> string -> IO ()
notebookSetTabLabelText self
self child
child string
tabText =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
tabText ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
tabTextPtr ->
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) CString
arg3 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> CString -> IO ()
gtk_notebook_set_tab_label_text Ptr Notebook
argPtr1 Ptr Widget
argPtr2 CString
arg3)
{-# LINE 938 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    CString
tabTextPtr


-- | Sets whether the notebook tab can be reordered via drag and drop or not.
--
-- * Available since Gtk version 2.10
--
notebookSetTabReorderable :: (NotebookClass self, WidgetClass child) => self
 -> child -- ^ @child@ - a child page
 -> Bool -- ^ @reorderable@ - whether the tab is reorderable or not.
 -> IO ()
notebookSetTabReorderable :: forall self child.
(NotebookClass self, WidgetClass child) =>
self -> child -> Bool -> IO ()
notebookSetTabReorderable self
self child
child Bool
reorderable =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> CInt -> IO ()
gtk_notebook_set_tab_reorderable Ptr Notebook
argPtr1 Ptr Widget
argPtr2 CInt
arg3)
{-# LINE 953 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
reorderable)

-- | Gets whether the tab can be reordered via drag and drop or not.
--
-- * Available since Gtk version 2.10
--
notebookGetTabReorderable :: (NotebookClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the child page
 -> IO Bool -- ^ return @True@ if the tab is reorderable.
notebookGetTabReorderable :: forall self child.
(NotebookClass self, WidgetClass child) =>
self -> child -> IO Bool
notebookGetTabReorderable self
self child
child = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> IO CInt
gtk_notebook_get_tab_reorderable Ptr Notebook
argPtr1 Ptr Widget
argPtr2)
{-# LINE 966 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)

-- | Sets whether the tab can be detached from notebook to another notebook or widget.
--
-- Note that 2 notebooks must share a common group identificator (see gtk_notebook_set_group_id()) to allow automatic tabs interchange between them.
--
-- If you want a widget to interact with a notebook through DnD (i.e.: accept dragged tabs from it) it must be set as a drop destination and accept the target "GTK_NOTEBOOK_TAB".
-- The notebook will fill the selection with a GtkWidget** pointing to the child widget that corresponds to the dropped tab.
--
-- If you want a notebook to accept drags from other widgets, you will have to set your own DnD code to do it.
--
-- * Available since Gtk version 2.10
--
notebookSetTabDetachable :: (NotebookClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the child page
 -> Bool -- ^ @detachable@ - whether the tab is detachable or not
 -> IO ()
notebookSetTabDetachable :: forall self child.
(NotebookClass self, WidgetClass child) =>
self -> child -> Bool -> IO ()
notebookSetTabDetachable self
self child
child Bool
detachable =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> CInt -> IO ()
gtk_notebook_set_tab_detachable Ptr Notebook
argPtr1 Ptr Widget
argPtr2 CInt
arg3)
{-# LINE 986 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
detachable)

-- | Returns whether the tab contents can be detached from notebook.
--
-- * Available since Gtk version 2.10
--
notebookGetTabDetachable :: (NotebookClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the child page
 -> IO Bool -- ^ return @True@ if the tab is detachable.
notebookGetTabDetachable :: forall self child.
(NotebookClass self, WidgetClass child) =>
self -> child -> IO Bool
notebookGetTabDetachable self
self child
child = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Notebook -> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO CInt) -> IO CInt)
-> (Ptr Notebook -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> IO CInt
gtk_notebook_get_tab_detachable Ptr Notebook
argPtr1 Ptr Widget
argPtr2)
{-# LINE 999 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)



-- | Sets widget as one of the action widgets. Depending on the pack type the widget will be placed
-- before or after the tabs. You can use a 'Box' if you need to pack more than one widget on the same
-- side.
--
-- Note that action widgets are "internal" children of the notebook and thus not included in the list
-- returned from 'containerForeach'.
--
-- * Available since Gtk version 2.20
--
notebookSetActionWidget :: (NotebookClass self, WidgetClass widget) => self
                        -> widget
                        -> PackType -- ^ @packType@ pack type of the action widget
                        -> IO ()
notebookSetActionWidget :: forall self widget.
(NotebookClass self, WidgetClass widget) =>
self -> widget -> PackType -> IO ()
notebookSetActionWidget self
self widget
widget PackType
packType =
  (\(Notebook ForeignPtr Notebook
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 -> ForeignPtr Notebook -> (Ptr Notebook -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO ()) -> IO ())
-> (Ptr Notebook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Notebook -> Ptr Widget -> CInt -> IO ()
gtk_notebook_set_action_widget Ptr Notebook
argPtr1 Ptr Widget
argPtr2 CInt
arg3)
{-# LINE 1019 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
    (toNotebook self)
    (widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PackType -> Int) -> PackType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackType -> Int
forall a. Enum a => a -> Int
fromEnum) PackType
packType)

-- | Gets one of the action widgets. See 'notebookSetActionWidget'.
--
-- * Available since Gtk version 2.20
--
notebookGetActionWidget :: NotebookClass self => self
                        -> PackType -- ^ @packType@ pack type of the action widget to receive
                        -> IO (Maybe Widget)
notebookGetActionWidget :: forall self.
NotebookClass self =>
self -> PackType -> IO (Maybe Widget)
notebookGetActionWidget self
self PackType
packType =
    (IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget) (IO (Ptr Widget) -> IO (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
    (\(Notebook ForeignPtr Notebook
arg1) CInt
arg2 -> ForeignPtr Notebook
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Notebook
arg1 ((Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Notebook -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Notebook
argPtr1 ->Ptr Notebook -> CInt -> IO (Ptr Widget)
gtk_notebook_get_action_widget Ptr Notebook
argPtr1 CInt
arg2)
{-# LINE 1033 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}
      (toNotebook self)
      ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PackType -> Int) -> PackType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackType -> Int
forall a. Enum a => a -> Int
fromEnum) PackType
packType)


--------------------
-- Attributes

-- | The index of the current page.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
notebookPage :: NotebookClass self => Attr self Int
notebookPage :: forall self. NotebookClass self => Attr self Int
notebookPage = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"page"

-- | Which side of the notebook holds the tabs.
--
-- Default value: 'PosTop'
--
notebookTabPos :: NotebookClass self => Attr self PositionType
notebookTabPos :: forall self. NotebookClass self => Attr self PositionType
notebookTabPos = (self -> IO PositionType)
-> (self -> PositionType -> IO ())
-> ReadWriteAttr self PositionType PositionType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO PositionType
forall self. NotebookClass self => self -> IO PositionType
notebookGetTabPos
  self -> PositionType -> IO ()
forall self. NotebookClass self => self -> PositionType -> IO ()
notebookSetTabPos

-- | Width of the border around the tab labels.
--
-- Default value: 2
--
notebookTabBorder :: NotebookClass self => WriteAttr self Int
notebookTabBorder :: forall self. NotebookClass self => WriteAttr self Int
notebookTabBorder = String -> WriteAttr self Int
forall gobj. GObjectClass gobj => String -> WriteAttr gobj Int
writeAttrFromUIntProperty String
"tab-border"

-- | Width of the horizontal border of tab labels.
--
-- Default value: 2
--
notebookTabHborder :: NotebookClass self => Attr self Int
notebookTabHborder :: forall self. NotebookClass self => Attr self Int
notebookTabHborder = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromUIntProperty String
"tab-hborder"

-- | Width of the vertical border of tab labels.
--
-- Default value: 2
--
notebookTabVborder :: NotebookClass self => Attr self Int
notebookTabVborder :: forall self. NotebookClass self => Attr self Int
notebookTabVborder = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromUIntProperty String
"tab-vborder"

-- | Whether tabs should be shown or not.
--
-- Default value: @True@
--
notebookShowTabs :: NotebookClass self => Attr self Bool
notebookShowTabs :: forall self. NotebookClass self => Attr self Bool
notebookShowTabs = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Bool
forall self. NotebookClass self => self -> IO Bool
notebookGetShowTabs
  self -> Bool -> IO ()
forall self. NotebookClass self => self -> Bool -> IO ()
notebookSetShowTabs

-- | Whether the border should be shown or not.
--
-- Default value: @True@
--
notebookShowBorder :: NotebookClass self => Attr self Bool
notebookShowBorder :: forall self. NotebookClass self => Attr self Bool
notebookShowBorder = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Bool
forall self. NotebookClass self => self -> IO Bool
notebookGetShowBorder
  self -> Bool -> IO ()
forall self. NotebookClass self => self -> Bool -> IO ()
notebookSetShowBorder

-- | If @True@, scroll arrows are added if there are too many tabs to fit.
--
-- Default value: @False@
--
notebookScrollable :: NotebookClass self => Attr self Bool
notebookScrollable :: forall self. NotebookClass self => Attr self Bool
notebookScrollable = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Bool
forall self. NotebookClass self => self -> IO Bool
notebookGetScrollable
  self -> Bool -> IO ()
forall self. NotebookClass self => self -> Bool -> IO ()
notebookSetScrollable

-- | If @True@, pressing the right mouse button on the notebook pops up a menu
-- that you can use to go to a page.
--
-- Default value: @False@
--
notebookEnablePopup :: NotebookClass self => Attr self Bool
notebookEnablePopup :: forall self. NotebookClass self => Attr self Bool
notebookEnablePopup = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"enable-popup"

-- | Whether tabs should have homogeneous sizes.
--
-- Default value: @False@
--
notebookHomogeneous :: NotebookClass self => Attr self Bool
notebookHomogeneous :: forall self. NotebookClass self => Attr self Bool
notebookHomogeneous = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"homogeneous"

-- | Switches to the page number @pageNum@.
--
-- Note that due to historical reasons, 'Notebook' refuses to switch to a
-- page unless the child widget is visible. Therefore, it is recommended to
-- show child widgets before adding them to a notebook.
--
-- Returns the page number of the current page.
--
notebookCurrentPage :: NotebookClass self => Attr self Int
notebookCurrentPage :: forall self. NotebookClass self => Attr self Int
notebookCurrentPage = (self -> IO Int)
-> (self -> Int -> IO ()) -> ReadWriteAttr self Int Int
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Int
forall self. NotebookClass self => self -> IO Int
notebookGetCurrentPage
  self -> Int -> IO ()
forall self. NotebookClass self => self -> Int -> IO ()
notebookSetCurrentPage

--------------------
-- Child Attributes

-- | The string displayed on the child's tab label.
--
-- Default value: @Nothing@
--
notebookChildTabLabel :: (NotebookClass self, WidgetClass child, GlibString string) => child -> Attr self string
notebookChildTabLabel :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
child -> Attr self string
notebookChildTabLabel = String -> child -> Attr self string
forall container child string.
(ContainerClass container, WidgetClass child, GlibString string) =>
String -> child -> Attr container string
newAttrFromContainerChildStringProperty String
"tab-label"

-- | The string displayed in the child's menu entry.
--
-- Default value: @Nothing@
--
notebookChildMenuLabel :: (NotebookClass self, WidgetClass child, GlibString string) => child -> Attr self string
notebookChildMenuLabel :: forall self child string.
(NotebookClass self, WidgetClass child, GlibString string) =>
child -> Attr self string
notebookChildMenuLabel = String -> child -> Attr self string
forall container child string.
(ContainerClass container, WidgetClass child, GlibString string) =>
String -> child -> Attr container string
newAttrFromContainerChildStringProperty String
"menu-label"

-- | The index of the child in the parent.
--
-- Allowed values: >= -1
--
-- Default value: 0
--
notebookChildPosition :: (NotebookClass self, WidgetClass child) => child -> Attr self Int
notebookChildPosition :: forall self child.
(NotebookClass self, WidgetClass child) =>
child -> Attr self Int
notebookChildPosition = String -> child -> Attr self Int
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Int
newAttrFromContainerChildIntProperty String
"position"

-- | The packing style of the child's tab.
--
-- Default value: 'PackGrow'
--
notebookChildTabPacking :: (NotebookClass self, WidgetClass child) => child -> Attr self Packing
notebookChildTabPacking :: forall self child.
(NotebookClass self, WidgetClass child) =>
child -> Attr self Packing
notebookChildTabPacking child
child = (self -> IO Packing)
-> (self -> Packing -> IO ()) -> ReadWriteAttr self Packing Packing
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  (\self
container -> do
     Bool
expand <- String -> child -> self -> IO Bool
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> IO Bool
containerChildGetPropertyBool String
"tab-expand" child
child self
container
     Bool
fill <- String -> child -> self -> IO Bool
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> IO Bool
containerChildGetPropertyBool String
"tab-fill" child
child self
container
     Packing -> IO Packing
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool -> Packing
toPacking Bool
expand Bool
fill))
  (\self
container Packing
packing ->
     case Packing -> (Bool, Bool)
fromPacking Packing
packing of
       (Bool
expand, Bool
fill) -> do
         String -> child -> self -> Bool -> IO ()
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> Bool -> IO ()
containerChildSetPropertyBool String
"tab-expand" child
child self
container Bool
expand
         String -> child -> self -> Bool -> IO ()
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> Bool -> IO ()
containerChildSetPropertyBool String
"tab-fill" child
child self
container Bool
fill)

-- | A 'PackType' indicating whether the child is packed with reference to the
-- start or end of the parent.
--
-- Default value: 'PackStart'
--
notebookChildTabPackType :: (NotebookClass self, WidgetClass child) => child -> Attr self PackType
notebookChildTabPackType :: forall self child.
(NotebookClass self, WidgetClass child) =>
child -> Attr self PackType
notebookChildTabPackType = String -> GType -> child -> Attr self PackType
forall container child enum.
(ContainerClass container, WidgetClass child, Enum enum) =>
String -> GType -> child -> Attr container enum
newAttrFromContainerChildEnumProperty String
"tab-pack"
                         GType
gtk_pack_type_get_type
{-# LINE 1184 "./Graphics/UI/Gtk/Layout/Notebook.chs" #-}

-- | Whether the tab is detachable.
--
-- Default value: @False@
--
notebookChildDetachable :: NotebookClass self => Attr self Bool
notebookChildDetachable :: forall self. NotebookClass self => Attr self Bool
notebookChildDetachable = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"detachable"

-- | Whether the tab is reorderable by user action or not.
--
-- Default value: @False@
--
notebookChildReorderable :: NotebookClass self => Attr self Bool
notebookChildReorderable :: forall self. NotebookClass self => Attr self Bool
notebookChildReorderable = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"reorderable"

-- | Whether to expand the child's tab or not.
--
-- Default value : @False@
--
notebookChildTabExpand :: NotebookClass self => Attr self Bool
notebookChildTabExpand :: forall self. NotebookClass self => Attr self Bool
notebookChildTabExpand = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"tab-expand"

-- | Whether the child's tab should fill the allocated area or not.
--
-- Default value : @False@
--
notebookChildTabFill :: NotebookClass self => Attr self Bool
notebookChildTabFill :: forall self. NotebookClass self => Attr self Bool
notebookChildTabFill = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"tab-fill"


-- | The 'notebookStyleArrowSpacing' property defines the spacing between the scroll arrows and the tabs.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
-- * Available since Gtk version 2.10
--
notebookStyleArrowSpacing :: NotebookClass self => ReadAttr self Bool
notebookStyleArrowSpacing :: forall self. NotebookClass self => ReadAttr self Bool
notebookStyleArrowSpacing = String -> ReadAttr self Bool
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty String
"arrow-spacing"


-- | The 'notebookStyleHasBackwardStepper' property determines whether the standard backward arrow button is displayed.
--
-- Default value: @True@
--
-- * Available since Gtk version 2.4
--
notebookStyleHasBackwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasBackwardStepper :: forall self. NotebookClass self => ReadAttr self Bool
notebookStyleHasBackwardStepper = String -> ReadAttr self Bool
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty String
"has-backward-stepper"

-- | The 'notebookStyleHasForwardStepper' property determines whether the standard forward arrow button is displayed.
--
-- Default value : @True@
--
-- * Available since Gtk version 2.4
--
notebookStyleHasForwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasForwardStepper :: forall self. NotebookClass self => ReadAttr self Bool
notebookStyleHasForwardStepper = String -> ReadAttr self Bool
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty String
"has-forward-stepper"

-- | The 'notebookStyleHasSecondaryBackwardStepper' property determines whether a second backward arrow button is displayed on the opposite end of the tab area.
--
-- Default value: @False@
--
-- * Available since Gtk version 2.4
--
notebookStyleHasSecondaryBackwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasSecondaryBackwardStepper :: forall self. NotebookClass self => ReadAttr self Bool
notebookStyleHasSecondaryBackwardStepper = String -> ReadAttr self Bool
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty String
"has-secondary-backward-stepper"

-- | The 'notebookStyleHasSecondaryForwardStepper' property determines whether a second forward arrow button is displayed on the opposite end of the tab area.
--
-- Default value: @False@
--
-- * Available since Gtk version 2.4
--
notebookStyleHasSecondaryForwardStepper :: NotebookClass self => ReadAttr self Bool
notebookStyleHasSecondaryForwardStepper :: forall self. NotebookClass self => ReadAttr self Bool
notebookStyleHasSecondaryForwardStepper = String -> ReadAttr self Bool
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty String
"has-secondary-forward-stepper"


-- | The 'notebookStyleTabCurvature' property defines size of tab curvature.
--
-- Allowed values: >= 0
--
-- Default value: 1
--
-- * Available since Gtk version 2.10
--
notebookStyleTabCurvature :: NotebookClass self => ReadAttr self Int
notebookStyleTabCurvature :: forall self. NotebookClass self => ReadAttr self Int
notebookStyleTabCurvature = String -> ReadAttr self Int
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty String
"tab-curvature"

-- | The 'notebookStyleTabOverlap' property defines size of tab overlap area.
--
-- Default value: 2
--
-- * Available since Gtk version 2.10
--
notebookStyleTabOverlap :: NotebookClass self => ReadAttr self Int
notebookStyleTabOverlap :: forall self. NotebookClass self => ReadAttr self Int
notebookStyleTabOverlap = String -> ReadAttr self Int
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty String
"tab-overlap"


--------------------
-- Signals

-- | Emitted when the user or a function changes the current page.
--
switchPage :: NotebookClass self => Signal self (Int -> IO ())
switchPage :: forall self. NotebookClass self => Signal self (Int -> IO ())
switchPage = (Bool -> self -> (Int -> IO ()) -> IO (ConnectId self))
-> Signal self (Int -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (\Bool
after self
obj Int -> IO ()
act ->
                     String
-> Bool
-> self
-> (Ptr Any -> Word -> IO ())
-> IO (ConnectId self)
forall obj a.
GObjectClass obj =>
String
-> Bool -> obj -> (Ptr a -> Word -> IO ()) -> IO (ConnectId obj)
connect_PTR_WORD__NONE String
"switch-page" Bool
after self
obj
                     (\Ptr Any
_ Word
page -> Int -> IO ()
act (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
page)))


-- | The 'pageReordered' signal is emitted in the notebook right after a page has been reordered.
--
-- * Available since Gtk+ version 2.10
--
pageReordered :: NotebookClass self => Signal self (Widget -> Int -> IO ())
pageReordered :: forall self.
NotebookClass self =>
Signal self (Widget -> Int -> IO ())
pageReordered = (Bool -> self -> (Widget -> Int -> IO ()) -> IO (ConnectId self))
-> Signal self (Widget -> Int -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool -> self -> (Widget -> Int -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> Int -> IO ()) -> IO (ConnectId obj)
connect_OBJECT_INT__NONE String
"page-reordered")

-- | The 'pageRemoved' signal is emitted in the notebook right after a page is removed from the notebook.
--
-- * Available since Gtk+ version 2.10
--
pageRemoved :: NotebookClass self => Signal self (Widget -> Int -> IO ())
pageRemoved :: forall self.
NotebookClass self =>
Signal self (Widget -> Int -> IO ())
pageRemoved = (Bool -> self -> (Widget -> Int -> IO ()) -> IO (ConnectId self))
-> Signal self (Widget -> Int -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool -> self -> (Widget -> Int -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> Int -> IO ()) -> IO (ConnectId obj)
connect_OBJECT_INT__NONE String
"page-removed")

-- | The 'pageAdded' signal is emitted in the notebook right after a page is added to the notebook.
--
-- * Available since Gtk+ version 2.10
--
pageAdded :: NotebookClass self => Signal self (Widget -> Int -> IO ())
pageAdded :: forall self.
NotebookClass self =>
Signal self (Widget -> Int -> IO ())
pageAdded = (Bool -> self -> (Widget -> Int -> IO ()) -> IO (ConnectId self))
-> Signal self (Widget -> Int -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool -> self -> (Widget -> Int -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> Int -> IO ()) -> IO (ConnectId obj)
connect_OBJECT_INT__NONE String
"page-added")


-- * Deprecated

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_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 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 :: CULong