{-# LINE 2 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Toolbar
--
-- Author : Axel Simon
--
-- Created: 23 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- 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.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Create bars of buttons and other widgets
--
module Graphics.UI.Gtk.MenuComboToolbar.Toolbar (
-- * Detail
--
-- | This widget underwent a significant overhaul in gtk 2.4 and the
-- recommended api changed substantially. The old interface is still supported
-- but it is not recommended.
--
-- * The following information applies to the new interface only.
--
-- A toolbar is created with a call to 'toolbarNew'.
--
-- A toolbar can contain instances of a subclass of 'ToolItem'. To add a
-- 'ToolItem' to the a toolbar, use 'toolbarInsert'. To remove an item from the
-- toolbar use 'containerRemove'. To add a button to the toolbar, add an
-- instance of 'ToolButton'.
--
-- Toolbar items can be visually grouped by adding instances of
-- 'SeparatorToolItem' to the toolbar. If a 'SeparatorToolItem' has the
-- \"expand\" property set to @True@ and the \"draw\" property set to @False@
-- the effect is to force all following items to the end of the toolbar.
--
-- Creating a context menu for the toolbar can be done using
-- 'onPopupContextMenu'.


-- | * The following information applies to the old interface only.
--
-- 'Button's, 'RadioButton's and 'ToggleButton's can be added by referring to
-- stock images. Their size can be changed by calling 'toolbarSetIconSize'. In
-- contrast, normal widget cannot be added. Due to the bad interface of
-- "Toolbar" mnemonics of 'RadioButton's and 'ToggleButton's are not honored.
--
-- All the append, insert and prepend functions use an internal function to
-- do the actual work. In fact the interface is pretty skrewed up: To insert
-- icons by using stock items is definitely the best practice as all other
-- images cannot react to 'toolbarSetIconSize' and other theming actions. On
-- the other hand 'toolbarInsertStock' always generates simple 'Button's
-- but is the only function that is able to insert 'Mnemonic's on the label.
-- Our solution is to use 'StockItem's to specify all 'Images' of the
-- 'Buttons'. If the user inserts 'RadioButton's or 'ToggleButton's, the stock
-- image lookup is done manually. A mnemonic in the labels is sadly not
-- honored this way.


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

-- * Types
  Toolbar,
  ToolbarClass,
  castToToolbar, gTypeToolbar,
  toToolbar,
  Orientation(..),
  ToolbarStyle(..),

-- * Constructors
  toolbarNew,

-- * Methods


  toolbarInsertNewButton,
  toolbarAppendNewButton,
  toolbarPrependNewButton,
  toolbarInsertNewToggleButton,
  toolbarAppendNewToggleButton,
  toolbarPrependNewToggleButton,
  toolbarInsertNewRadioButton,
  toolbarAppendNewRadioButton,
  toolbarPrependNewRadioButton,
  toolbarInsertNewWidget,
  toolbarAppendNewWidget,
  toolbarPrependNewWidget,

  toolbarSetOrientation,
  toolbarGetOrientation,

  toolbarSetStyle,
  toolbarGetStyle,
  toolbarUnsetStyle,

  toolbarSetTooltips,
  toolbarGetTooltips,

  IconSize(..),

  toolbarSetIconSize,

  toolbarGetIconSize,

  toolbarInsert,
  toolbarGetItemIndex,
  toolbarGetNItems,
  toolbarGetNthItem,
  toolbarGetDropIndex,
  toolbarSetDropHighlightItem,
  toolbarSetShowArrow,
  toolbarGetShowArrow,
  ReliefStyle(..),
  toolbarGetReliefStyle,


-- * Attributes

  toolbarOrientation,


  toolbarShowArrow,



  toolbarTooltips,


  toolbarStyle,

-- * Child Attributes
  toolbarChildExpand,
  toolbarChildHomogeneous,

-- * Signals
  onOrientationChanged,
  afterOrientationChanged,
  onStyleChanged,
  afterStyleChanged,
  onPopupContextMenu,
  afterPopupContextMenu,
  ) where

import Control.Monad (liftM)


import Data.Maybe (fromJust)
import qualified Data.Text as T (filter)
import Graphics.UI.Gtk.General.StockItems
import Graphics.UI.Gtk.Display.Image (imageNewFromStock)
import System.Glib.UTFString


import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 179 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 180 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
import Graphics.UI.Gtk.Abstract.ContainerChildProperties
import Graphics.UI.Gtk.General.Enums (Orientation(..), ToolbarStyle(..),
                                         ReliefStyle(..))
import Graphics.UI.Gtk.General.Structs (


                                         toolbarChildToggleButton,
                                         toolbarChildRadioButton,


                                         IconSize(..))


{-# LINE 193 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}

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

-- | Creates a new toolbar.
--
toolbarNew :: IO Toolbar
toolbarNew :: IO Toolbar
toolbarNew =
  (ForeignPtr Toolbar -> Toolbar, FinalizerPtr Toolbar)
-> IO (Ptr Toolbar) -> IO Toolbar
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Toolbar -> Toolbar, FinalizerPtr Toolbar)
forall {a}. (ForeignPtr Toolbar -> Toolbar, FinalizerPtr a)
mkToolbar (IO (Ptr Toolbar) -> IO Toolbar) -> IO (Ptr Toolbar) -> IO Toolbar
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Toolbar) -> IO (Ptr Widget) -> IO (Ptr Toolbar)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Toolbar
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Toolbar) (IO (Ptr Widget) -> IO (Ptr Toolbar))
-> IO (Ptr Widget) -> IO (Ptr Toolbar)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_toolbar_new
{-# LINE 204 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}

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


-- Make tooltips or not?
--
mkToolText :: GlibString string => Maybe (string,string) -> (CString -> CString -> IO a) -> IO a
mkToolText :: forall string a.
GlibString string =>
Maybe (string, string) -> (CString -> CString -> IO a) -> IO a
mkToolText Maybe (string, string)
Nothing CString -> CString -> IO a
fun = CString -> CString -> IO a
fun CString
forall a. Ptr a
nullPtr CString
forall a. Ptr a
nullPtr
mkToolText (Just (string
text,string
private)) CString -> CString -> IO a
fun = string -> (CString -> IO a) -> IO a
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
text ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
txtPtr ->
  string -> (CString -> IO a) -> IO a
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
private ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
prvPtr -> CString -> CString -> IO a
fun CString
txtPtr CString
prvPtr

-- | Insert a new 'Button' into the 'Toolbar'.
--
-- The new 'Button' is created at position @pos@, counting from 0.
--
-- The icon and label for the button is referenced by @stockId@
-- which must be a valid entry in the 'Toolbar's Style or the
-- default 'IconFactory'.
--
-- If you wish to have 'Tooltips' added to this button you can
-- specify @Just (tipText, tipPrivate)@ , otherwise specify @Nothing@.
--
-- The newly created 'Button' is returned. Use this button to
-- add an action function with @\"connectToClicked\"@.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarInsertNewButton :: (ToolbarClass self, GlibString string) => self
 -> Int
 -> StockId
 -> Maybe (string,string)
 -> IO Button
toolbarInsertNewButton :: forall self string.
(ToolbarClass self, GlibString string) =>
self -> Int -> StockId -> Maybe (string, string) -> IO Button
toolbarInsertNewButton self
self Int
pos StockId
stockId Maybe (string, string)
tooltips =
  StockId -> (CString -> IO Button) -> IO Button
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. StockId -> (CString -> IO a) -> IO a
withUTFString StockId
stockId ((CString -> IO Button) -> IO Button)
-> (CString -> IO Button) -> IO Button
forall a b. (a -> b) -> a -> b
$ \CString
stockPtr ->
  Maybe (string, string)
-> (CString -> CString -> IO Button) -> IO Button
forall string a.
GlibString string =>
Maybe (string, string) -> (CString -> CString -> IO a) -> IO a
mkToolText Maybe (string, string)
tooltips ((CString -> CString -> IO Button) -> IO Button)
-> (CString -> CString -> IO Button) -> IO Button
forall a b. (a -> b) -> a -> b
$ \CString
textPtr CString
privPtr ->
  (ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$ (Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
forall a b. (a -> b) -> a -> b
$
  (\(Toolbar ForeignPtr Toolbar
arg1) CString
arg2 CString
arg3 CString
arg4 FunPtr (IO ())
arg5 Ptr ()
arg6 CInt
arg7 -> ForeignPtr Toolbar
-> (Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar
-> CString
-> CString
-> CString
-> FunPtr (IO ())
-> Ptr ()
-> CInt
-> IO (Ptr Widget)
gtk_toolbar_insert_stock Ptr Toolbar
argPtr1 CString
arg2 CString
arg3 CString
arg4 FunPtr (IO ())
arg5 Ptr ()
arg6 CInt
arg7)
{-# LINE 244 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    CString
stockPtr
    CString
textPtr
    CString
privPtr
    FunPtr (IO ())
forall a. FunPtr a
nullFunPtr
    Ptr ()
forall a. Ptr a
nullPtr
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos)

-- | Append a new 'Button' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarAppendNewButton :: (ToolbarClass self, GlibString string) => self
 -> StockId
 -> Maybe (string, string)
 -> IO Button
toolbarAppendNewButton :: forall self string.
(ToolbarClass self, GlibString string) =>
self -> StockId -> Maybe (string, string) -> IO Button
toolbarAppendNewButton self
self = self -> Int -> StockId -> Maybe (string, string) -> IO Button
forall self string.
(ToolbarClass self, GlibString string) =>
self -> Int -> StockId -> Maybe (string, string) -> IO Button
toolbarInsertNewButton self
self (-Int
1)

-- | Prepend a new 'Button' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarPrependNewButton :: (ToolbarClass self, GlibString string) => self
 -> StockId
 -> Maybe (string, string)
 -> IO Button
toolbarPrependNewButton :: forall self string.
(ToolbarClass self, GlibString string) =>
self -> StockId -> Maybe (string, string) -> IO Button
toolbarPrependNewButton self
self = self -> Int -> StockId -> Maybe (string, string) -> IO Button
forall self string.
(ToolbarClass self, GlibString string) =>
self -> Int -> StockId -> Maybe (string, string) -> IO Button
toolbarInsertNewButton self
self Int
0

-- | Insert a new 'ToggleButton' into the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarInsertNewToggleButton :: (ToolbarClass self, GlibString string) => self
 -> Int
 -> StockId
 -> Maybe (string, string)
 -> IO ToggleButton
toolbarInsertNewToggleButton :: forall self string.
(ToolbarClass self, GlibString string) =>
self -> Int -> StockId -> Maybe (string, string) -> IO ToggleButton
toolbarInsertNewToggleButton self
self Int
pos StockId
stockId Maybe (string, string)
tooltips = do
  Maybe StockItem
mItem <- StockId -> IO (Maybe StockItem)
stockLookupItem StockId
stockId
  StockItem
item <- case Maybe StockItem
mItem of
    (Just StockItem
item) -> StockItem -> IO StockItem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StockItem
item
    Maybe StockItem
Nothing -> (Maybe StockItem -> StockItem)
-> IO (Maybe StockItem) -> IO StockItem
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe StockItem -> StockItem
forall a. HasCallStack => Maybe a -> a
fromJust (IO (Maybe StockItem) -> IO StockItem)
-> IO (Maybe StockItem) -> IO StockItem
forall a b. (a -> b) -> a -> b
$ StockId -> IO (Maybe StockItem)
stockLookupItem StockId
stockMissingImage
  let label :: StockId
label = ((Char -> Bool) -> StockId -> StockId
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_')) (StockId -> StockId) -> StockId -> StockId
forall a b. (a -> b) -> a -> b
$ StockItem -> StockId
siLabel StockItem
item
  IconSize
size <- Toolbar -> IO IconSize
forall self. ToolbarClass self => self -> IO IconSize
toolbarGetIconSize (self -> Toolbar
forall o. ToolbarClass o => o -> Toolbar
toToolbar self
self)
  Image
image <- StockId -> IconSize -> IO Image
imageNewFromStock StockId
stockId IconSize
size
  (ForeignPtr ToggleButton -> ToggleButton,
 FinalizerPtr ToggleButton)
-> IO (Ptr ToggleButton) -> IO ToggleButton
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ToggleButton -> ToggleButton,
 FinalizerPtr ToggleButton)
forall {a}.
(ForeignPtr ToggleButton -> ToggleButton, FinalizerPtr a)
mkToggleButton (IO (Ptr ToggleButton) -> IO ToggleButton)
-> IO (Ptr ToggleButton) -> IO ToggleButton
forall a b. (a -> b) -> a -> b
$ (Ptr Widget -> Ptr ToggleButton)
-> IO (Ptr Widget) -> IO (Ptr ToggleButton)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr Widget -> Ptr ToggleButton
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr Widget) -> IO (Ptr ToggleButton))
-> IO (Ptr Widget) -> IO (Ptr ToggleButton)
forall a b. (a -> b) -> a -> b
$
    StockId -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. StockId -> (CString -> IO a) -> IO a
withUTFString StockId
label ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
lblPtr -> Maybe (string, string)
-> (CString -> CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall string a.
GlibString string =>
Maybe (string, string) -> (CString -> CString -> IO a) -> IO a
mkToolText Maybe (string, string)
tooltips ((CString -> CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
textPtr CString
privPtr ->
    (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 (Widget ForeignPtr Widget
arg3) CString
arg4 CString
arg5 CString
arg6 (Widget ForeignPtr Widget
arg7) FunPtr (IO ())
arg8 Ptr ()
arg9 CInt
arg10 -> ForeignPtr Toolbar
-> (Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
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
arg3 ((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
argPtr3 ->ForeignPtr Widget
-> (Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg7 ((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
argPtr7 ->Ptr Toolbar
-> CInt
-> Ptr Widget
-> CString
-> CString
-> CString
-> Ptr Widget
-> FunPtr (IO ())
-> Ptr ()
-> CInt
-> IO (Ptr Widget)
gtk_toolbar_insert_element Ptr Toolbar
argPtr1 CInt
arg2 Ptr Widget
argPtr3 CString
arg4 CString
arg5 CString
arg6 Ptr Widget
argPtr7 FunPtr (IO ())
arg8 Ptr ()
arg9 CInt
arg10) (self -> Toolbar
forall o. ToolbarClass o => o -> Toolbar
toToolbar self
self)
    CInt
toolbarChildToggleButton (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) CString
lblPtr
    CString
textPtr CString
privPtr (Image -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Image
image) FunPtr (IO ())
forall a. FunPtr a
nullFunPtr Ptr ()
forall a. Ptr a
nullPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos)

-- | Append a new 'ToggleButton' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarAppendNewToggleButton :: (ToolbarClass self, GlibString string) => self
 -> StockId
 -> Maybe (string, string)
 -> IO ToggleButton
toolbarAppendNewToggleButton :: forall self string.
(ToolbarClass self, GlibString string) =>
self -> StockId -> Maybe (string, string) -> IO ToggleButton
toolbarAppendNewToggleButton self
self = self -> Int -> StockId -> Maybe (string, string) -> IO ToggleButton
forall self string.
(ToolbarClass self, GlibString string) =>
self -> Int -> StockId -> Maybe (string, string) -> IO ToggleButton
toolbarInsertNewToggleButton self
self (-Int
1)

-- | Prepend a new 'ToggleButton' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarPrependNewToggleButton :: (ToolbarClass self, GlibString string) => self
 -> StockId
 -> Maybe (string, string)
 -> IO ToggleButton
toolbarPrependNewToggleButton :: forall self string.
(ToolbarClass self, GlibString string) =>
self -> StockId -> Maybe (string, string) -> IO ToggleButton
toolbarPrependNewToggleButton self
self = self -> Int -> StockId -> Maybe (string, string) -> IO ToggleButton
forall self string.
(ToolbarClass self, GlibString string) =>
self -> Int -> StockId -> Maybe (string, string) -> IO ToggleButton
toolbarInsertNewToggleButton self
self Int
0

-- | Insert a new 'RadioButton' into the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- The @parent@ argument must be set to another
-- 'RadioButton' in the group. If @Nothing@ is given,
-- a new group is generated (which is the desired behaviour for the
-- first button of a group).
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarInsertNewRadioButton :: (ToolbarClass self, RadioButtonClass rb, GlibString string) => self
 -> Int
 -> StockId
 -> Maybe (string,string)
 -> Maybe rb
 -> IO RadioButton
toolbarInsertNewRadioButton :: forall self rb string.
(ToolbarClass self, RadioButtonClass rb, GlibString string) =>
self
-> Int
-> StockId
-> Maybe (string, string)
-> Maybe rb
-> IO RadioButton
toolbarInsertNewRadioButton self
self Int
pos StockId
stockId Maybe (string, string)
tooltips Maybe rb
rb = do
  Maybe StockItem
mItem <- StockId -> IO (Maybe StockItem)
stockLookupItem StockId
stockId
  StockItem
item <- case Maybe StockItem
mItem of
    (Just StockItem
item) -> StockItem -> IO StockItem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StockItem
item
    Maybe StockItem
Nothing -> (Maybe StockItem -> StockItem)
-> IO (Maybe StockItem) -> IO StockItem
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe StockItem -> StockItem
forall a. HasCallStack => Maybe a -> a
fromJust (IO (Maybe StockItem) -> IO StockItem)
-> IO (Maybe StockItem) -> IO StockItem
forall a b. (a -> b) -> a -> b
$ StockId -> IO (Maybe StockItem)
stockLookupItem StockId
stockMissingImage
  let label :: StockId
label = ((Char -> Bool) -> StockId -> StockId
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_')) (StockId -> StockId) -> StockId -> StockId
forall a b. (a -> b) -> a -> b
$ StockItem -> StockId
siLabel StockItem
item
  IconSize
size <- Toolbar -> IO IconSize
forall self. ToolbarClass self => self -> IO IconSize
toolbarGetIconSize (self -> Toolbar
forall o. ToolbarClass o => o -> Toolbar
toToolbar self
self)
  Image
image <- StockId -> IconSize -> IO Image
imageNewFromStock StockId
stockId IconSize
size
  (ForeignPtr RadioButton -> RadioButton, FinalizerPtr RadioButton)
-> IO (Ptr RadioButton) -> IO RadioButton
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr RadioButton -> RadioButton, FinalizerPtr RadioButton)
forall {a}. (ForeignPtr RadioButton -> RadioButton, FinalizerPtr a)
mkRadioButton (IO (Ptr RadioButton) -> IO RadioButton)
-> IO (Ptr RadioButton) -> IO RadioButton
forall a b. (a -> b) -> a -> b
$ (Ptr Widget -> Ptr RadioButton)
-> IO (Ptr Widget) -> IO (Ptr RadioButton)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr Widget -> Ptr RadioButton
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr Widget) -> IO (Ptr RadioButton))
-> IO (Ptr Widget) -> IO (Ptr RadioButton)
forall a b. (a -> b) -> a -> b
$
    StockId -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. StockId -> (CString -> IO a) -> IO a
withUTFString StockId
label ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
lblPtr -> Maybe (string, string)
-> (CString -> CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall string a.
GlibString string =>
Maybe (string, string) -> (CString -> CString -> IO a) -> IO a
mkToolText Maybe (string, string)
tooltips ((CString -> CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
textPtr CString
privPtr ->
    (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 (Widget ForeignPtr Widget
arg3) CString
arg4 CString
arg5 CString
arg6 (Widget ForeignPtr Widget
arg7) FunPtr (IO ())
arg8 Ptr ()
arg9 CInt
arg10 -> ForeignPtr Toolbar
-> (Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Toolbar -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
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
arg3 ((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
argPtr3 ->ForeignPtr Widget
-> (Ptr Widget -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg7 ((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
argPtr7 ->Ptr Toolbar
-> CInt
-> Ptr Widget
-> CString
-> CString
-> CString
-> Ptr Widget
-> FunPtr (IO ())
-> Ptr ()
-> CInt
-> IO (Ptr Widget)
gtk_toolbar_insert_element Ptr Toolbar
argPtr1 CInt
arg2 Ptr Widget
argPtr3 CString
arg4 CString
arg5 CString
arg6 Ptr Widget
argPtr7 FunPtr (IO ())
arg8 Ptr ()
arg9 CInt
arg10) (self -> Toolbar
forall o. ToolbarClass o => o -> Toolbar
toToolbar self
self)
    CInt
toolbarChildRadioButton (Widget -> (rb -> Widget) -> Maybe rb -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) rb -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe rb
rb)
      CString
lblPtr CString
textPtr CString
privPtr (Image -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Image
image) FunPtr (IO ())
forall a. FunPtr a
nullFunPtr Ptr ()
forall a. Ptr a
nullPtr
      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos)

-- | Append a new 'RadioButton' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarAppendNewRadioButton :: (ToolbarClass self, RadioButtonClass rb, GlibString string) => self
 -> StockId
 -> Maybe (string, string)
 -> Maybe rb
 -> IO RadioButton
toolbarAppendNewRadioButton :: forall self rb string.
(ToolbarClass self, RadioButtonClass rb, GlibString string) =>
self
-> StockId -> Maybe (string, string) -> Maybe rb -> IO RadioButton
toolbarAppendNewRadioButton self
self = self
-> Int
-> StockId
-> Maybe (string, string)
-> Maybe rb
-> IO RadioButton
forall self rb string.
(ToolbarClass self, RadioButtonClass rb, GlibString string) =>
self
-> Int
-> StockId
-> Maybe (string, string)
-> Maybe rb
-> IO RadioButton
toolbarInsertNewRadioButton self
self (-Int
1)

-- | Prepend a new 'RadioButton' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarPrependNewRadioButton :: (ToolbarClass self, RadioButtonClass rb, GlibString string) => self
 -> StockId
 -> Maybe (string, string)
 -> Maybe rb
 -> IO RadioButton
toolbarPrependNewRadioButton :: forall self rb string.
(ToolbarClass self, RadioButtonClass rb, GlibString string) =>
self
-> StockId -> Maybe (string, string) -> Maybe rb -> IO RadioButton
toolbarPrependNewRadioButton self
self = self
-> Int
-> StockId
-> Maybe (string, string)
-> Maybe rb
-> IO RadioButton
forall self rb string.
(ToolbarClass self, RadioButtonClass rb, GlibString string) =>
self
-> Int
-> StockId
-> Maybe (string, string)
-> Maybe rb
-> IO RadioButton
toolbarInsertNewRadioButton self
self Int
0

-- | Insert an arbitrary widget to the 'Toolbar'.
--
-- The 'Widget' should not be a button. Adding 'Button's
-- with the 'toolbarInsertButton',... functions with stock
-- objects is much better as it takes care of theme handling.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarInsertNewWidget :: (ToolbarClass self, WidgetClass w, GlibString string) => self
 -> Int
 -> w
 -> Maybe (string,string)
 -> IO ()
toolbarInsertNewWidget :: forall self w string.
(ToolbarClass self, WidgetClass w, GlibString string) =>
self -> Int -> w -> Maybe (string, string) -> IO ()
toolbarInsertNewWidget self
self Int
pos w
w Maybe (string, string)
tooltips =
  Maybe (string, string) -> (CString -> CString -> IO ()) -> IO ()
forall string a.
GlibString string =>
Maybe (string, string) -> (CString -> CString -> IO a) -> IO a
mkToolText Maybe (string, string)
tooltips ((CString -> CString -> IO ()) -> IO ())
-> (CString -> CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
textPtr CString
privPtr ->
  (\(Toolbar ForeignPtr Toolbar
arg1) (Widget ForeignPtr Widget
arg2) CString
arg3 CString
arg4 CInt
arg5 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
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 Toolbar -> Ptr Widget -> CString -> CString -> CInt -> IO ()
gtk_toolbar_insert_widget Ptr Toolbar
argPtr1 Ptr Widget
argPtr2 CString
arg3 CString
arg4 CInt
arg5)
{-# LINE 420 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (w -> Widget
forall o. WidgetClass o => o -> Widget
toWidget w
w)
    CString
textPtr
    CString
privPtr
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos)

-- | Append a new 'Widget' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarAppendNewWidget :: (ToolbarClass self, WidgetClass w, GlibString string) => self
 -> w
 -> Maybe (string, string)
 -> IO ()
toolbarAppendNewWidget :: forall self w string.
(ToolbarClass self, WidgetClass w, GlibString string) =>
self -> w -> Maybe (string, string) -> IO ()
toolbarAppendNewWidget self
self = self -> Int -> w -> Maybe (string, string) -> IO ()
forall self w string.
(ToolbarClass self, WidgetClass w, GlibString string) =>
self -> Int -> w -> Maybe (string, string) -> IO ()
toolbarInsertNewWidget self
self (-Int
1)

-- | Prepend a new 'Widget' to the 'Toolbar'.
--
-- See 'toolbarInsertNewButton' for details.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
-- Removed in Gtk3.
toolbarPrependNewWidget :: (ToolbarClass self, WidgetClass w, GlibString string) => self
 -> w
 -> Maybe (string, string)
 -> IO ()
toolbarPrependNewWidget :: forall self w string.
(ToolbarClass self, WidgetClass w, GlibString string) =>
self -> w -> Maybe (string, string) -> IO ()
toolbarPrependNewWidget self
self = self -> Int -> w -> Maybe (string, string) -> IO ()
forall self w string.
(ToolbarClass self, WidgetClass w, GlibString string) =>
self -> Int -> w -> Maybe (string, string) -> IO ()
toolbarInsertNewWidget self
self Int
0


-- | Sets whether a toolbar should appear horizontally or vertically.
--
-- Removed in Gtk3.
toolbarSetOrientation :: ToolbarClass self => self -> Orientation -> IO ()
toolbarSetOrientation :: forall self. ToolbarClass self => self -> Orientation -> IO ()
toolbarSetOrientation self
self Orientation
orientation =
  (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> CInt -> IO ()
gtk_toolbar_set_orientation Ptr Toolbar
argPtr1 CInt
arg2)
{-# LINE 461 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Orientation -> Int) -> Orientation -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orientation -> Int
forall a. Enum a => a -> Int
fromEnum) Orientation
orientation)

-- | Retrieves the current orientation of the toolbar. See
-- 'toolbarSetOrientation'.
--
-- Removed in Gtk3.
toolbarGetOrientation :: ToolbarClass self => self -> IO Orientation
toolbarGetOrientation :: forall self. ToolbarClass self => self -> IO Orientation
toolbarGetOrientation self
self =
  (CInt -> Orientation) -> IO CInt -> IO Orientation
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Orientation
forall a. Enum a => Int -> a
toEnum (Int -> Orientation) -> (CInt -> Int) -> CInt -> Orientation
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 Orientation) -> IO CInt -> IO Orientation
forall a b. (a -> b) -> a -> b
$
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO CInt
gtk_toolbar_get_orientation Ptr Toolbar
argPtr1)
{-# LINE 472 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)

-- | Alters the view of the toolbar to display either icons only, text only, or
-- both.
--
toolbarSetStyle :: ToolbarClass self => self -> ToolbarStyle -> IO ()
toolbarSetStyle :: forall self. ToolbarClass self => self -> ToolbarStyle -> IO ()
toolbarSetStyle self
self ToolbarStyle
style =
  (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> CInt -> IO ()
gtk_toolbar_set_style Ptr Toolbar
argPtr1 CInt
arg2)
{-# LINE 480 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ToolbarStyle -> Int) -> ToolbarStyle -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToolbarStyle -> Int
forall a. Enum a => a -> Int
fromEnum) ToolbarStyle
style)

-- | Retrieves whether the toolbar has text, icons, or both. See
-- 'toolbarSetStyle'.
--
toolbarGetStyle :: ToolbarClass self => self -> IO ToolbarStyle
toolbarGetStyle :: forall self. ToolbarClass self => self -> IO ToolbarStyle
toolbarGetStyle self
self =
  (CInt -> ToolbarStyle) -> IO CInt -> IO ToolbarStyle
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ToolbarStyle
forall a. Enum a => Int -> a
toEnum (Int -> ToolbarStyle) -> (CInt -> Int) -> CInt -> ToolbarStyle
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 ToolbarStyle) -> IO CInt -> IO ToolbarStyle
forall a b. (a -> b) -> a -> b
$
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO CInt
gtk_toolbar_get_style Ptr Toolbar
argPtr1)
{-# LINE 490 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)

-- | Unsets a toolbar style set with 'toolbarSetStyle', so that user
-- preferences will be used to determine the toolbar style.
--
toolbarUnsetStyle :: ToolbarClass self => self -> IO ()
toolbarUnsetStyle :: forall self. ToolbarClass self => self -> IO ()
toolbarUnsetStyle self
self =
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO ()
gtk_toolbar_unset_style Ptr Toolbar
argPtr1)
{-# LINE 498 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)


-- | Sets if the tooltips of a toolbar should be active or not.
--
-- Removed in Gtk3.
toolbarSetTooltips :: ToolbarClass self => self
 -> Bool -- ^ @enable@ - set to @False@ to disable the tooltips, or @True@ to
          -- enable them.
 -> IO ()
toolbarSetTooltips :: forall self. ToolbarClass self => self -> Bool -> IO ()
toolbarSetTooltips self
self Bool
enable =
  (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> CInt -> IO ()
gtk_toolbar_set_tooltips Ptr Toolbar
argPtr1 CInt
arg2)
{-# LINE 510 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
enable)

-- | Retrieves whether tooltips are enabled. See 'toolbarSetTooltips'.
--
-- Removed in Gtk3.
toolbarGetTooltips :: ToolbarClass self => self -> IO Bool
toolbarGetTooltips :: forall self. ToolbarClass self => self -> IO Bool
toolbarGetTooltips 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
$
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO CInt
gtk_toolbar_get_tooltips Ptr Toolbar
argPtr1)
{-# LINE 520 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)



-- | This function sets the size of stock icons in the toolbar. You can call
-- it both before you add the icons and after they\'ve been added. The size you
-- set will override user preferences for the default icon size.
--
-- It might be sensible to restrict oneself to 'IconSizeSmallToolbar' and
-- 'IconSizeLargeToolbar'.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
toolbarSetIconSize :: ToolbarClass self => self -> IconSize -> IO ()
toolbarSetIconSize :: forall self. ToolbarClass self => self -> IconSize -> IO ()
toolbarSetIconSize self
self IconSize
iconSize =
  (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> CInt -> IO ()
gtk_toolbar_set_icon_size Ptr Toolbar
argPtr1 CInt
arg2)
{-# LINE 537 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (IconSize -> Int) -> IconSize -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconSize -> Int
forall a. Enum a => a -> Int
fromEnum) IconSize
iconSize)


-- | Retrieves the icon size for the toolbar. See 'toolbarSetIconSize'.
--
toolbarGetIconSize :: ToolbarClass self => self -> IO IconSize
toolbarGetIconSize :: forall self. ToolbarClass self => self -> IO IconSize
toolbarGetIconSize self
self =
  (CInt -> IconSize) -> IO CInt -> IO IconSize
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> IconSize
forall a. Enum a => Int -> a
toEnum (Int -> IconSize) -> (CInt -> Int) -> CInt -> IconSize
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 IconSize) -> IO CInt -> IO IconSize
forall a b. (a -> b) -> a -> b
$
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO CInt
gtk_toolbar_get_icon_size Ptr Toolbar
argPtr1)
{-# LINE 547 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)


-- | Insert a 'ToolItem' into the toolbar at position @pos@. If @pos@ is 0 the
-- item is prepended to the start of the toolbar. If @pos@ is negative, the
-- item is appended to the end of the toolbar.
--
-- * Available since Gtk version 2.4
--
toolbarInsert :: (ToolbarClass self, ToolItemClass item) => self
 -> item -- ^ @item@ - a 'ToolItem'
 -> Int -- ^ @pos@ - the position of the new item
 -> IO ()
toolbarInsert :: forall self item.
(ToolbarClass self, ToolItemClass item) =>
self -> item -> Int -> IO ()
toolbarInsert self
self item
item Int
pos =
  (\(Toolbar ForeignPtr Toolbar
arg1) (ToolItem ForeignPtr ToolItem
arg2) CInt
arg3 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->ForeignPtr ToolItem -> (Ptr ToolItem -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolItem
arg2 ((Ptr ToolItem -> IO ()) -> IO ())
-> (Ptr ToolItem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolItem
argPtr2 ->Ptr Toolbar -> Ptr ToolItem -> CInt -> IO ()
gtk_toolbar_insert Ptr Toolbar
argPtr1 Ptr ToolItem
argPtr2 CInt
arg3)
{-# LINE 562 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (item -> ToolItem
forall o. ToolItemClass o => o -> ToolItem
toToolItem item
item)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos)

-- | Returns the position of @item@ on the toolbar, starting from 0. It is an
-- error if @item@ is not a child of the toolbar.
--
-- * Available since Gtk version 2.4
--
toolbarGetItemIndex :: (ToolbarClass self, ToolItemClass item) => self
 -> item -- ^ @item@ - a 'ToolItem' that is a child of @toolbar@
 -> IO Int -- ^ returns the position of item on the toolbar.
toolbarGetItemIndex :: forall self item.
(ToolbarClass self, ToolItemClass item) =>
self -> item -> IO Int
toolbarGetItemIndex self
self item
item =
  (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
$
  (\(Toolbar ForeignPtr Toolbar
arg1) (ToolItem ForeignPtr ToolItem
arg2) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->ForeignPtr ToolItem -> (Ptr ToolItem -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolItem
arg2 ((Ptr ToolItem -> IO CInt) -> IO CInt)
-> (Ptr ToolItem -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ToolItem
argPtr2 ->Ptr Toolbar -> Ptr ToolItem -> IO CInt
gtk_toolbar_get_item_index Ptr Toolbar
argPtr1 Ptr ToolItem
argPtr2)
{-# LINE 577 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (item -> ToolItem
forall o. ToolItemClass o => o -> ToolItem
toToolItem item
item)

-- | Returns the number of items on the toolbar.
--
-- * Available since Gtk version 2.4
--
toolbarGetNItems :: ToolbarClass self => self -> IO Int
toolbarGetNItems :: forall self. ToolbarClass self => self -> IO Int
toolbarGetNItems 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
$
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO CInt
gtk_toolbar_get_n_items Ptr Toolbar
argPtr1)
{-# LINE 588 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)

-- | Returns the @n@\'th item on toolbar, or @Nothing@ if the toolbar does not
-- contain an @n@'th item.
--
-- * Available since Gtk+ version 2.4
--
toolbarGetNthItem :: ToolbarClass self => self
 -> Int -- ^ @n@ - A position on the toolbar
 -> IO (Maybe ToolItem) -- ^ returns The @n@'th 'ToolItem' on the toolbar, or
                        -- @Nothing@ if there isn't an @n@\'th item.
toolbarGetNthItem :: forall self.
ToolbarClass self =>
self -> Int -> IO (Maybe ToolItem)
toolbarGetNthItem self
self Int
n =
  (IO (Ptr ToolItem) -> IO ToolItem)
-> IO (Ptr ToolItem) -> IO (Maybe ToolItem)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr ToolItem -> ToolItem, FinalizerPtr ToolItem)
-> IO (Ptr ToolItem) -> IO ToolItem
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ToolItem -> ToolItem, FinalizerPtr ToolItem)
forall {a}. (ForeignPtr ToolItem -> ToolItem, FinalizerPtr a)
mkToolItem) (IO (Ptr ToolItem) -> IO (Maybe ToolItem))
-> IO (Ptr ToolItem) -> IO (Maybe ToolItem)
forall a b. (a -> b) -> a -> b
$
  (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 -> ForeignPtr Toolbar
-> (Ptr Toolbar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem))
-> (Ptr Toolbar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> CInt -> IO (Ptr ToolItem)
gtk_toolbar_get_nth_item Ptr Toolbar
argPtr1 CInt
arg2)
{-# LINE 602 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

-- | Returns the position corresponding to the indicated point on toolbar.
-- This is useful when dragging items to the toolbar: this function returns the
-- position a new item should be inserted.
--
-- * Available since Gtk version 2.4
--
toolbarGetDropIndex :: ToolbarClass self => self
 -> (Int, Int) -- ^ @(x, y)@ - coordinate of a point on the toolbar. Note that
           -- @(x, y)@ are in toolbar coordinates, not window coordinates.
 -> IO Int -- ^ returns The position corresponding to the point @(x, y)@ on
           -- the toolbar.
toolbarGetDropIndex :: forall self. ToolbarClass self => self -> (Int, Int) -> IO Int
toolbarGetDropIndex self
self (Int
x,Int
y) =
  (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
$
  (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> CInt -> CInt -> IO CInt
gtk_toolbar_get_drop_index Ptr Toolbar
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 619 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

-- | Highlights the toolbar to give an idea of what it would look like if @item@
-- was added to toolbar at the position indicated by @index@. If @item@ is
-- @Nothing@, highlighting is turned off (and the index is ignored).
--
-- The @toolItem@ passed to this function must not be part of any widget
-- hierarchy. When an item is set as a drop highlight item it can not added to
-- any widget hierarchy or used as highlight item for another toolbar.
--
-- * Available since Gtk version 2.4
--
toolbarSetDropHighlightItem :: (ToolbarClass self, ToolItemClass toolItem) => self
 -> Maybe toolItem -- ^ @toolItem@ - a 'ToolItem', or @Nothing@ to turn of
                   -- highlighting
 -> Int -- ^ @index@ - a position on the toolbar
 -> IO ()
toolbarSetDropHighlightItem :: forall self toolItem.
(ToolbarClass self, ToolItemClass toolItem) =>
self -> Maybe toolItem -> Int -> IO ()
toolbarSetDropHighlightItem self
self Maybe toolItem
toolItem Int
index =
  (\(Toolbar ForeignPtr Toolbar
arg1) (ToolItem ForeignPtr ToolItem
arg2) CInt
arg3 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->ForeignPtr ToolItem -> (Ptr ToolItem -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolItem
arg2 ((Ptr ToolItem -> IO ()) -> IO ())
-> (Ptr ToolItem -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolItem
argPtr2 ->Ptr Toolbar -> Ptr ToolItem -> CInt -> IO ()
gtk_toolbar_set_drop_highlight_item Ptr Toolbar
argPtr1 Ptr ToolItem
argPtr2 CInt
arg3)
{-# LINE 640 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (ToolItem -> (toolItem -> ToolItem) -> Maybe toolItem -> ToolItem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr ToolItem -> ToolItem
ToolItem ForeignPtr ToolItem
forall a. ForeignPtr a
nullForeignPtr) toolItem -> ToolItem
forall o. ToolItemClass o => o -> ToolItem
toToolItem Maybe toolItem
toolItem)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)

-- | Sets whether to show an overflow menu when the toolbar doesn't have room
-- for all items on it. If @True@, items that there are not room are available
-- through an overflow menu.
--
-- * Available since Gtk version 2.4
--
toolbarSetShowArrow :: ToolbarClass self => self -> Bool -> IO ()
toolbarSetShowArrow :: forall self. ToolbarClass self => self -> Bool -> IO ()
toolbarSetShowArrow self
self Bool
showArrow =
  (\(Toolbar ForeignPtr Toolbar
arg1) CInt
arg2 -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO ()) -> IO ())
-> (Ptr Toolbar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> CInt -> IO ()
gtk_toolbar_set_show_arrow Ptr Toolbar
argPtr1 CInt
arg2)
{-# LINE 653 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
showArrow)

-- | Returns whether the toolbar has an overflow menu. See
-- 'toolbarSetShowArrow'.
--
-- * Available since Gtk+ version 2.4
--
toolbarGetShowArrow :: ToolbarClass self => self -> IO Bool
toolbarGetShowArrow :: forall self. ToolbarClass self => self -> IO Bool
toolbarGetShowArrow 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
$
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO CInt
gtk_toolbar_get_show_arrow Ptr Toolbar
argPtr1)
{-# LINE 665 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)

-- | Returns the relief style of buttons on the toolbar. See 'buttonSetRelief'.
--
-- * Available since Gtk+ version 2.4
--
toolbarGetReliefStyle :: ToolbarClass self => self -> IO ReliefStyle
toolbarGetReliefStyle :: forall self. ToolbarClass self => self -> IO ReliefStyle
toolbarGetReliefStyle self
self =
  (CInt -> ReliefStyle) -> IO CInt -> IO ReliefStyle
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ReliefStyle
forall a. Enum a => Int -> a
toEnum (Int -> ReliefStyle) -> (CInt -> Int) -> CInt -> ReliefStyle
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 ReliefStyle) -> IO CInt -> IO ReliefStyle
forall a b. (a -> b) -> a -> b
$
  (\(Toolbar ForeignPtr Toolbar
arg1) -> ForeignPtr Toolbar -> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Toolbar
arg1 ((Ptr Toolbar -> IO CInt) -> IO CInt)
-> (Ptr Toolbar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Toolbar
argPtr1 ->Ptr Toolbar -> IO CInt
gtk_toolbar_get_relief_style Ptr Toolbar
argPtr1)
{-# LINE 675 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}
    (toToolbar self)


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


-- | The orientation of the toolbar.
--
-- Default value: 'OrientationHorizontal'
--
-- Removed in Gtk3.
toolbarOrientation :: ToolbarClass self => Attr self Orientation
toolbarOrientation :: forall self. ToolbarClass self => Attr self Orientation
toolbarOrientation = (self -> IO Orientation)
-> (self -> Orientation -> IO ())
-> ReadWriteAttr self Orientation Orientation
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Orientation
forall self. ToolbarClass self => self -> IO Orientation
toolbarGetOrientation
  self -> Orientation -> IO ()
forall self. ToolbarClass self => self -> Orientation -> IO ()
toolbarSetOrientation


-- | How to draw the toolbar.
--
-- Default value: 'ToolbarIcons'
--
toolbarStyle :: ToolbarClass self => Attr self ToolbarStyle
toolbarStyle :: forall self. ToolbarClass self => Attr self ToolbarStyle
toolbarStyle = String -> GType -> Attr self ToolbarStyle
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"toolbar-style"
  GType
gtk_toolbar_style_get_type
{-# LINE 700 "./Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs" #-}


-- | If an arrow should be shown if the toolbar doesn't fit.
--
-- Default value: @True@
--
toolbarShowArrow :: ToolbarClass self => Attr self Bool
toolbarShowArrow :: forall self. ToolbarClass self => Attr self Bool
toolbarShowArrow = (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. ToolbarClass self => self -> IO Bool
toolbarGetShowArrow
  self -> Bool -> IO ()
forall self. ToolbarClass self => self -> Bool -> IO ()
toolbarSetShowArrow




-- | If the tooltips of the toolbar should be active or not.
--
-- Default value: @True@
--
-- Removed in Gtk3.
toolbarTooltips :: ToolbarClass self => Attr self Bool
toolbarTooltips :: forall self. ToolbarClass self => Attr self Bool
toolbarTooltips = (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. ToolbarClass self => self -> IO Bool
toolbarGetTooltips
  self -> Bool -> IO ()
forall self. ToolbarClass self => self -> Bool -> IO ()
toolbarSetTooltips


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

-- | Whether the item should receive extra space when the toolbar grows.
--
-- Default value: @True@
--
toolbarChildExpand :: (ToolbarClass self, WidgetClass child) => child -> Attr self Bool
toolbarChildExpand :: forall self child.
(ToolbarClass self, WidgetClass child) =>
child -> Attr self Bool
toolbarChildExpand = String -> child -> Attr self Bool
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Bool
newAttrFromContainerChildBoolProperty String
"expand"

-- | Whether the item should be the same size as other homogeneous items.
--
-- Default value: @True@
--
toolbarChildHomogeneous :: (ToolbarClass self, WidgetClass child) => child -> Attr self Bool
toolbarChildHomogeneous :: forall self child.
(ToolbarClass self, WidgetClass child) =>
child -> Attr self Bool
toolbarChildHomogeneous = String -> child -> Attr self Bool
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Bool
newAttrFromContainerChildBoolProperty String
"homogeneous"

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

-- | Emitted when the orientation of the toolbar changes.
--
onOrientationChanged, afterOrientationChanged :: ToolbarClass self => self
 -> (Orientation -> IO ())
 -> IO (ConnectId self)
onOrientationChanged :: forall self.
ToolbarClass self =>
self -> (Orientation -> IO ()) -> IO (ConnectId self)
onOrientationChanged = String
-> Bool -> self -> (Orientation -> IO ()) -> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> IO ()) -> IO (ConnectId obj)
connect_ENUM__NONE String
"orientation-changed" Bool
False
afterOrientationChanged :: forall self.
ToolbarClass self =>
self -> (Orientation -> IO ()) -> IO (ConnectId self)
afterOrientationChanged = String
-> Bool -> self -> (Orientation -> IO ()) -> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> IO ()) -> IO (ConnectId obj)
connect_ENUM__NONE String
"orientation-changed" Bool
True

-- | Emitted when the style of the toolbar changes.
--
onStyleChanged, afterStyleChanged :: ToolbarClass self => self
 -> (ToolbarStyle -> IO ())
 -> IO (ConnectId self)
onStyleChanged :: forall self.
ToolbarClass self =>
self -> (ToolbarStyle -> IO ()) -> IO (ConnectId self)
onStyleChanged = String
-> Bool -> self -> (ToolbarStyle -> IO ()) -> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> IO ()) -> IO (ConnectId obj)
connect_ENUM__NONE String
"style-changed" Bool
False
afterStyleChanged :: forall self.
ToolbarClass self =>
self -> (ToolbarStyle -> IO ()) -> IO (ConnectId self)
afterStyleChanged = String
-> Bool -> self -> (ToolbarStyle -> IO ()) -> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> IO ()) -> IO (ConnectId obj)
connect_ENUM__NONE String
"style-changed" Bool
True

-- | Emitted when the user right-clicks the toolbar or uses the keybinding to
-- display a popup menu.
--
-- Application developers should handle this signal if they want to display
-- a context menu on the toolbar. The context-menu should appear at the
-- coordinates given by @x@ and @y@. The mouse button number is given by the
-- @button@ parameter. If the menu was popped up using the keyboard, @button@
-- is -1.
--
onPopupContextMenu, afterPopupContextMenu :: ToolbarClass self => self
 -> (Int -> Int -> Int -> IO Bool) -- ^ @(\x y button -> ...)@ - The handler
                                   -- should return True if the signal was
                                   -- handled, False if not.
 -> IO (ConnectId self)
onPopupContextMenu :: forall self.
ToolbarClass self =>
self -> (Int -> Int -> Int -> IO Bool) -> IO (ConnectId self)
onPopupContextMenu = String
-> Bool
-> self
-> (Int -> Int -> Int -> IO Bool)
-> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String
-> Bool
-> obj
-> (Int -> Int -> Int -> IO Bool)
-> IO (ConnectId obj)
connect_INT_INT_INT__BOOL String
"popup-context-menu" Bool
False
afterPopupContextMenu :: forall self.
ToolbarClass self =>
self -> (Int -> Int -> Int -> IO Bool) -> IO (ConnectId self)
afterPopupContextMenu = String
-> Bool
-> self
-> (Int -> Int -> Int -> IO Bool)
-> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String
-> Bool
-> obj
-> (Int -> Int -> Int -> IO Bool)
-> IO (ConnectId obj)
connect_INT_INT_INT__BOOL String
"popup-context-menu" Bool
True

foreign import ccall unsafe "gtk_toolbar_new"
  gtk_toolbar_new :: (IO (Ptr Widget))

foreign import ccall unsafe "gtk_toolbar_insert_stock"
  gtk_toolbar_insert_stock :: ((Ptr Toolbar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((FunPtr (IO ())) -> ((Ptr ()) -> (CInt -> (IO (Ptr Widget)))))))))

foreign import ccall unsafe "gtk_toolbar_insert_element"
  gtk_toolbar_insert_element :: ((Ptr Toolbar) -> (CInt -> ((Ptr Widget) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr Widget) -> ((FunPtr (IO ())) -> ((Ptr ()) -> (CInt -> (IO (Ptr Widget))))))))))))

foreign import ccall unsafe "gtk_toolbar_insert_widget"
  gtk_toolbar_insert_widget :: ((Ptr Toolbar) -> ((Ptr Widget) -> ((Ptr CChar) -> ((Ptr CChar) -> (CInt -> (IO ()))))))

foreign import ccall safe "gtk_toolbar_set_orientation"
  gtk_toolbar_set_orientation :: ((Ptr Toolbar) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_toolbar_get_orientation"
  gtk_toolbar_get_orientation :: ((Ptr Toolbar) -> (IO CInt))

foreign import ccall safe "gtk_toolbar_set_style"
  gtk_toolbar_set_style :: ((Ptr Toolbar) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_toolbar_get_style"
  gtk_toolbar_get_style :: ((Ptr Toolbar) -> (IO CInt))

foreign import ccall safe "gtk_toolbar_unset_style"
  gtk_toolbar_unset_style :: ((Ptr Toolbar) -> (IO ()))

foreign import ccall safe "gtk_toolbar_set_tooltips"
  gtk_toolbar_set_tooltips :: ((Ptr Toolbar) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_toolbar_get_tooltips"
  gtk_toolbar_get_tooltips :: ((Ptr Toolbar) -> (IO CInt))

foreign import ccall safe "gtk_toolbar_set_icon_size"
  gtk_toolbar_set_icon_size :: ((Ptr Toolbar) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_toolbar_get_icon_size"
  gtk_toolbar_get_icon_size :: ((Ptr Toolbar) -> (IO CInt))

foreign import ccall safe "gtk_toolbar_insert"
  gtk_toolbar_insert :: ((Ptr Toolbar) -> ((Ptr ToolItem) -> (CInt -> (IO ()))))

foreign import ccall unsafe "gtk_toolbar_get_item_index"
  gtk_toolbar_get_item_index :: ((Ptr Toolbar) -> ((Ptr ToolItem) -> (IO CInt)))

foreign import ccall unsafe "gtk_toolbar_get_n_items"
  gtk_toolbar_get_n_items :: ((Ptr Toolbar) -> (IO CInt))

foreign import ccall unsafe "gtk_toolbar_get_nth_item"
  gtk_toolbar_get_nth_item :: ((Ptr Toolbar) -> (CInt -> (IO (Ptr ToolItem))))

foreign import ccall unsafe "gtk_toolbar_get_drop_index"
  gtk_toolbar_get_drop_index :: ((Ptr Toolbar) -> (CInt -> (CInt -> (IO CInt))))

foreign import ccall safe "gtk_toolbar_set_drop_highlight_item"
  gtk_toolbar_set_drop_highlight_item :: ((Ptr Toolbar) -> ((Ptr ToolItem) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_toolbar_set_show_arrow"
  gtk_toolbar_set_show_arrow :: ((Ptr Toolbar) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_toolbar_get_show_arrow"
  gtk_toolbar_get_show_arrow :: ((Ptr Toolbar) -> (IO CInt))

foreign import ccall unsafe "gtk_toolbar_get_relief_style"
  gtk_toolbar_get_relief_style :: ((Ptr Toolbar) -> (IO CInt))

foreign import ccall unsafe "gtk_toolbar_style_get_type"
  gtk_toolbar_style_get_type :: CUInt