1{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedStrings #-}
3-- -*-haskell-*-
4--  GIMP Toolkit (GTK) Widget ToolButton
5--
6--  Author : Duncan Coutts
7--
8--  Created: 7 April 2005
9--
10--  Copyright (C) 2005 Duncan Coutts
11--
12--  This library is free software; you can redistribute it and/or
13--  modify it under the terms of the GNU Lesser General Public
14--  License as published by the Free Software Foundation; either
15--  version 2.1 of the License, or (at your option) any later version.
16--
17--  This library is distributed in the hope that it will be useful,
18--  but WITHOUT ANY WARRANTY; without even the implied warranty of
19--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20--  Lesser General Public License for more details.
21--
22-- |
23-- Maintainer  : gtk2hs-users@lists.sourceforge.net
24-- Stability   : provisional
25-- Portability : portable (depends on GHC)
26--
27-- A 'ToolItem' subclass that displays buttons
28--
29-- * Module available since Gtk+ version 2.4
30--
31module Graphics.UI.Gtk.MenuComboToolbar.ToolButton (
32-- * Detail
33--
34-- | 'ToolButton's are 'ToolItems' containing buttons.
35--
36-- Use 'toolButtonNew' to create a new 'ToolButton'. Use
37-- 'toolButtonNewWithStock' to create a 'ToolButton' containing a stock item.
38--
39-- The label of a 'ToolButton' is determined by the properties
40-- \"label_widget\", \"label\", and \"stock_id\". If \"label_widget\" is
41-- not @Nothing@,
42-- then that widget is used as the label. Otherwise, if \"label\" is
43-- not @Nothing@,
44-- that string is used as the label. Otherwise, if \"stock_id\" is not
45-- @Nothing@, the label is
46-- determined by the stock item. Otherwise, the button does not have a label.
47--
48-- The icon of a 'ToolButton' is determined by the properties
49-- \"icon_widget\" and \"stock_id\". If \"icon_widget\" is not @Nothing@, then
50-- that widget is used as the icon. Otherwise, if \"stock_id\" is not @Nothing@,
51-- the icon is determined by the stock item. Otherwise, the button does not have
52-- a label.
53
54-- * Class Hierarchy
55-- |
56-- @
57-- |  'GObject'
58-- |   +----'Object'
59-- |         +----'Widget'
60-- |               +----'Container'
61-- |                     +----'Bin'
62-- |                           +----'ToolItem'
63-- |                                 +----ToolButton
64-- |                                       +----'MenuToolButton'
65-- |                                       +----'ToggleToolButton'
66-- @
67
68#if GTK_CHECK_VERSION(2,4,0)
69-- * Types
70  ToolButton,
71  ToolButtonClass,
72  castToToolButton, gTypeToolButton,
73  toToolButton,
74
75-- * Constructors
76  toolButtonNew,
77  toolButtonNewFromStock,
78
79-- * Methods
80  toolButtonSetLabel,
81  toolButtonGetLabel,
82  toolButtonSetUseUnderline,
83  toolButtonGetUseUnderline,
84  toolButtonSetStockId,
85  toolButtonGetStockId,
86  toolButtonSetIconWidget,
87  toolButtonGetIconWidget,
88  toolButtonSetLabelWidget,
89  toolButtonGetLabelWidget,
90#if GTK_CHECK_VERSION(2,8,0)
91  toolButtonSetIconName,
92  toolButtonGetIconName,
93#endif
94
95-- * Attributes
96  toolButtonLabel,
97  toolButtonUseUnderline,
98  toolButtonLabelWidget,
99  toolButtonStockId,
100#if GTK_CHECK_VERSION(2,8,0)
101  toolButtonIconName,
102#endif
103  toolButtonIconWidget,
104
105-- * Signals
106  onToolButtonClicked,
107  afterToolButtonClicked,
108#endif
109  ) where
110
111import Control.Monad    (liftM)
112
113import System.Glib.FFI
114import System.Glib.UTFString
115import System.Glib.Attributes
116import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
117{#import Graphics.UI.Gtk.Types#}
118{#import Graphics.UI.Gtk.Signals#}
119import Graphics.UI.Gtk.General.StockItems
120
121{# context lib="gtk" prefix="gtk" #}
122
123#if GTK_CHECK_VERSION(2,4,0)
124--------------------
125-- Constructors
126
127-- | Creates a new 'ToolButton' using @iconWidget@ as icon and @label@ as
128-- label.
129--
130toolButtonNew :: (WidgetClass iconWidget, GlibString string) =>
131    Maybe iconWidget -- ^ @iconWidget@ - a widget that will be used as icon
132                     -- widget, or @Nothing@
133 -> Maybe string     -- ^ @label@ - a string that will be used as label, or
134                     -- @Nothing@
135 -> IO ToolButton
136toolButtonNew iconWidget label =
137  makeNewObject mkToolButton $
138  liftM (castPtr :: Ptr ToolItem -> Ptr ToolButton) $
139  maybeWith withUTFString label $ \labelPtr ->
140  {# call gtk_tool_button_new #}
141    (maybe (Widget nullForeignPtr) toWidget iconWidget)
142    labelPtr
143
144-- | Creates a new 'ToolButton' containing the image and text from a stock
145-- item.
146--
147-- It is an error if @stockId@ is not a name of a stock item.
148--
149toolButtonNewFromStock ::
150    StockId       -- ^ @stockId@ - the name of the stock item
151 -> IO ToolButton
152toolButtonNewFromStock stockId =
153  makeNewObject mkToolButton $
154  liftM (castPtr :: Ptr ToolItem -> Ptr ToolButton) $
155  withUTFString stockId $ \stockIdPtr ->
156  {# call gtk_tool_button_new_from_stock #}
157    stockIdPtr
158
159--------------------
160-- Methods
161
162-- | Sets @label@ as the label used for the tool button. The \"label\"
163-- property only has an effect if not overridden by a non-@Nothing@
164-- \"label_widget\" property. If both the \"label_widget\" and \"label\"
165-- properties are @Nothing@, the label is determined by the \"stock_id\"
166-- property. If the \"stock_id\" property is also @Nothing@, @button@ will not
167-- have a label.
168--
169toolButtonSetLabel :: (ToolButtonClass self, GlibString string) => self
170 -> Maybe string -- ^ @label@ - a string that will be used as label, or
171                 -- @Nothing@.
172 -> IO ()
173toolButtonSetLabel self label =
174  maybeWith withUTFString label $ \labelPtr ->
175  {# call gtk_tool_button_set_label #}
176    (toToolButton self)
177    labelPtr
178
179-- | Returns the label used by the tool button, or @Nothing@ if the tool
180-- button doesn't have a label. or uses a the label from a stock item.
181--
182toolButtonGetLabel :: (ToolButtonClass self, GlibString string) => self -> IO (Maybe string)
183toolButtonGetLabel self =
184  {# call gtk_tool_button_get_label #}
185    (toToolButton self)
186  >>= maybePeek peekUTFString
187
188-- | If set, an underline in the label property indicates that the next
189-- character should be used for the mnemonic accelerator key in the overflow
190-- menu. For example, if the label property is \"_Open\" and @useUnderline@ is
191-- @True@, the label on the tool button will be \"Open\" and the item on the
192-- overflow menu will have an underlined \'O\'.
193--
194-- Labels shown on tool buttons never have mnemonics on them; this property
195-- only affects the menu item on the overflow menu.
196--
197toolButtonSetUseUnderline :: ToolButtonClass self => self -> Bool -> IO ()
198toolButtonSetUseUnderline self useUnderline =
199  {# call gtk_tool_button_set_use_underline #}
200    (toToolButton self)
201    (fromBool useUnderline)
202
203-- | Returns whether underscores in the label property are used as mnemonics
204-- on menu items on the overflow menu. See 'toolButtonSetUseUnderline'.
205--
206toolButtonGetUseUnderline :: ToolButtonClass self => self -> IO Bool
207toolButtonGetUseUnderline self =
208  liftM toBool $
209  {# call gtk_tool_button_get_use_underline #}
210    (toToolButton self)
211
212-- | Sets the name of the stock item. See 'toolButtonNewFromStock'. The
213-- stock_id property only has an effect if not overridden by non-@Nothing@
214-- \"label\" and \"icon_widget\" properties.
215--
216toolButtonSetStockId :: ToolButtonClass self => self
217 -> Maybe StockId -- ^ @stockId@ - a name of a stock item, or @Nothing@
218 -> IO ()
219toolButtonSetStockId self stockId =
220  maybeWith withUTFString stockId $ \stockIdPtr ->
221  {# call gtk_tool_button_set_stock_id #}
222    (toToolButton self)
223    stockIdPtr
224
225-- | Returns the name of the stock item. See 'toolButtonSetStockId'.
226--
227toolButtonGetStockId :: ToolButtonClass self => self -> IO (Maybe StockId)
228toolButtonGetStockId self =
229  {# call gtk_tool_button_get_stock_id #}
230    (toToolButton self)
231  >>= maybePeek peekUTFString
232
233-- | Sets @icon@ as the widget used as icon on @button@. If @iconWidget@ is
234-- @Nothing@ the icon is determined by the \"stock_id\" property. If the
235-- \"stock_id\" property is also @Nothing@, the button will not have an icon.
236--
237toolButtonSetIconWidget :: (ToolButtonClass self, WidgetClass iconWidget) => self
238 -> Maybe iconWidget -- ^ @iconWidget@ - the widget used as icon, or @Nothing@
239 -> IO ()
240toolButtonSetIconWidget self iconWidget =
241  {# call gtk_tool_button_set_icon_widget #}
242    (toToolButton self)
243    (maybe (Widget nullForeignPtr) toWidget iconWidget)
244
245-- | Return the widget used as icon widget on @button@. See
246-- 'toolButtonSetIconWidget'.
247--
248toolButtonGetIconWidget :: ToolButtonClass self => self
249 -> IO (Maybe Widget) -- ^ returns The widget used as icon on @button@, or
250                      -- @Nothing@.
251toolButtonGetIconWidget self =
252  maybeNull (makeNewObject mkWidget) $
253  {# call gtk_tool_button_get_icon_widget #}
254    (toToolButton self)
255
256-- | Sets @labelWidget@ as the widget that will be used as the label for
257-- @button@. If @labelWidget@ is @Nothing@ the \"label\" property is used as
258-- label. If \"label\" is also @Nothing@, the label in the stock item
259-- determined by the \"stock_id\" property is used as label. If \"stock_id\" is
260-- also @Nothing@, @button@ does not have a label.
261--
262toolButtonSetLabelWidget :: (ToolButtonClass self, WidgetClass labelWidget) => self
263 -> Maybe labelWidget -- ^ @labelWidget@ - the widget used as label, or
264                      -- @Nothing@
265 -> IO ()
266toolButtonSetLabelWidget self labelWidget =
267  {# call gtk_tool_button_set_label_widget #}
268    (toToolButton self)
269    (maybe (Widget nullForeignPtr) toWidget labelWidget)
270
271-- | Returns the widget used as label on @button@. See
272-- 'toolButtonSetLabelWidget'.
273--
274toolButtonGetLabelWidget :: ToolButtonClass self => self
275 -> IO (Maybe Widget) -- ^ returns The widget used as label on @button@, or
276                      -- @Nothing@.
277toolButtonGetLabelWidget self =
278  maybeNull (makeNewObject mkWidget) $
279  {# call gtk_tool_button_get_label_widget #}
280    (toToolButton self)
281
282#if GTK_CHECK_VERSION(2,8,0)
283-- | Sets the icon for the tool button from a named themed icon. See the docs
284-- for 'IconTheme' for more details. The \"icon_name\" property only has an
285-- effect if not overridden by the \"label\", \"icon_widget\" and \"stock_id\"
286-- properties.
287--
288-- * Available since Gtk+ version 2.8
289--
290toolButtonSetIconName :: (ToolButtonClass self, GlibString string) => self
291 -> string -- ^ @iconName@ - the name of the themed icon
292 -> IO ()
293toolButtonSetIconName self iconName =
294  withUTFString iconName $ \iconNamePtr ->
295  {# call gtk_tool_button_set_icon_name #}
296    (toToolButton self)
297    iconNamePtr
298
299-- | Returns the name of the themed icon for the tool button, see
300-- 'toolButtonSetIconName'.
301--
302-- * Available since Gtk+ version 2.8
303--
304toolButtonGetIconName :: (ToolButtonClass self, GlibString string) => self
305 -> IO string -- ^ returns the icon name or @\"\"@ if the tool button has no
306              -- themed icon.
307toolButtonGetIconName self =
308  {# call gtk_tool_button_get_icon_name #}
309    (toToolButton self)
310  >>= \strPtr -> if strPtr == nullPtr
311                then return ""
312                else peekUTFString strPtr
313#endif
314
315--------------------
316-- Attributes
317
318-- | Text to show in the item.
319--
320-- Default value: @Nothing@
321--
322toolButtonLabel :: (ToolButtonClass self, GlibString string) => Attr self (Maybe string)
323toolButtonLabel = newAttr
324  toolButtonGetLabel
325  toolButtonSetLabel
326
327-- | If set, an underline in the label property indicates that the next
328-- character should be used for the mnemonic accelerator key in the overflow
329-- menu.
330--
331-- Default value: @False@
332--
333toolButtonUseUnderline :: ToolButtonClass self => Attr self Bool
334toolButtonUseUnderline = newAttr
335  toolButtonGetUseUnderline
336  toolButtonSetUseUnderline
337
338-- | Widget to use as the item label.
339--
340toolButtonLabelWidget :: (ToolButtonClass self, WidgetClass labelWidget) => ReadWriteAttr self (Maybe Widget) (Maybe labelWidget)
341toolButtonLabelWidget = newAttr
342  toolButtonGetLabelWidget
343  toolButtonSetLabelWidget
344
345-- | The stock icon displayed on the item.
346--
347-- Default value: @Nothing@
348--
349toolButtonStockId :: ToolButtonClass self => ReadWriteAttr self (Maybe StockId) (Maybe StockId)
350toolButtonStockId = newAttr
351  toolButtonGetStockId
352  toolButtonSetStockId
353
354#if GTK_CHECK_VERSION(2,8,0)
355-- | The name of the themed icon displayed on the item. This property only has
356-- an effect if not overridden by \"label\", \"icon_widget\" or \"stock_id\"
357-- properties.
358--
359-- Default value: \"\"
360--
361toolButtonIconName :: (ToolButtonClass self, GlibString string) => Attr self string
362toolButtonIconName = newAttr
363  toolButtonGetIconName
364  toolButtonSetIconName
365#endif
366
367-- | Icon widget to display in the item.
368--
369toolButtonIconWidget :: (ToolButtonClass self, WidgetClass iconWidget) => ReadWriteAttr self (Maybe Widget) (Maybe iconWidget)
370toolButtonIconWidget = newAttr
371  toolButtonGetIconWidget
372  toolButtonSetIconWidget
373
374--------------------
375-- Signals
376
377-- | This signal is emitted when the tool button is clicked with the mouse or
378-- activated with the keyboard.
379--
380onToolButtonClicked, afterToolButtonClicked :: ToolButtonClass self => self
381 -> IO ()
382 -> IO (ConnectId self)
383onToolButtonClicked = connect_NONE__NONE "clicked" False
384afterToolButtonClicked = connect_NONE__NONE "clicked" True
385#endif
386