1{-# LANGUAGE CPP #-}
2-- -*-haskell-*-
3--  GIMP Toolkit (GTK) Widget RadioButton
4--
5--  Author : Axel Simon
6--
7--  Created: 15 May 2001
8--
9--  Copyright (C) 1999-2005 Axel Simon
10--
11--  This library is free software; you can redistribute it and/or
12--  modify it under the terms of the GNU Lesser General Public
13--  License as published by the Free Software Foundation; either
14--  version 2.1 of the License, or (at your option) any later version.
15--
16--  This library is distributed in the hope that it will be useful,
17--  but WITHOUT ANY WARRANTY; without even the implied warranty of
18--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19--  Lesser General Public License for more details.
20--
21-- Note:
22--
23-- No function that directly accesses the group is bound. This is due to the
24--   difficulties assuring that these groups are valid as the group is a plain
25--   GSList from Glib.
26--
27-- |
28-- Maintainer  : gtk2hs-users@lists.sourceforge.net
29-- Stability   : provisional
30-- Portability : portable (depends on GHC)
31--
32-- A choice from multiple check buttons
33--
34module Graphics.UI.Gtk.Buttons.RadioButton (
35-- * Detail
36--
37-- | A single radio button performs the same basic function as a
38-- 'CheckButton', as its position in the object hierarchy reflects. It is only
39-- when multiple radio buttons are grouped together that they become a
40-- different user interface component in their own right.
41--
42-- Every radio button is a member of some group of radio buttons. When one
43-- is selected, all other radio buttons in the same group are deselected. A
44-- 'RadioButton' is one way of giving the user a choice from many options.
45--
46-- Radio button widgets are created with 'radioButtonNew'.
47-- Optionally, 'radioButtonNewWithLabel' can be used if you want a
48-- text label on the radio button.
49--
50-- For the radio button functions that take an existing group, the groups are
51-- represented by any of their members. So when adding widgets to an existing
52-- group of radio buttons, use 'radioButtonNewFromWidget' with a 'RadioButton'
53-- that is already a member of the group. The convenience function
54-- 'radioButtonNewWithLabelFromWidget' is also provided.
55--
56-- To remove a 'RadioButton' from one group and make it part of a new one,
57-- use 'radioButtonSetGroup'.
58--
59-- * How to create a group of two radio buttons.
60--
61-- >
62-- > createRadioButtons :: IO ()
63-- > createRadioButtons = do
64-- >   window <- windowNew
65-- >   box <- vBoxNew True 2
66-- >
67-- >   -- Create a radio button with a Entry widget
68-- >   radio1 <- radioButtonNew
69-- >   entry <- entryNew
70-- >   containerAdd radio1 entry
71-- >
72-- >   -- Create a radio button with a label
73-- >   radio2 <- radioButtonNewWithLabelFromWidget
74-- >               radio1 "I'm the second radio button."
75-- >
76-- >   -- Pack them into a box, then show all the widgets
77-- >   boxPackStart box radio1 PackGrow 2
78-- >   boxPackStart box radio2 PackGrow 2
79-- >   containerAdd window box
80-- >   widgetShowAll window
81-- >
82--
83-- When an unselected button in the group is clicked the clicked button
84-- receives the \"toggled\" signal, as does the previously selected button.
85-- Inside the \"toggled\" handler,
86-- 'Graphics.UI.Gtk.Buttons.ToggleButton.toggleButtonGetActive' can be used to
87-- determine if the button has been selected or deselected.
88
89-- * Class Hierarchy
90-- |
91-- @
92-- |  'GObject'
93-- |   +----'Object'
94-- |         +----'Widget'
95-- |               +----'Container'
96-- |                     +----'Bin'
97-- |                           +----'Button'
98-- |                                 +----'ToggleButton'
99-- |                                       +----'CheckButton'
100-- |                                             +----RadioButton
101-- @
102
103-- * Types
104  RadioButton,
105  RadioButtonClass,
106  castToRadioButton, gTypeRadioButton,
107  toRadioButton,
108
109-- * Constructors
110  radioButtonNew,
111  radioButtonNewWithLabel,
112  radioButtonNewWithMnemonic,
113  radioButtonNewFromWidget,
114  radioButtonNewWithLabelFromWidget,
115  radioButtonNewWithMnemonicFromWidget,
116
117  -- * Compatibilty aliases
118  radioButtonNewJoinGroup,
119  radioButtonNewJoinGroupWithLabel,
120  radioButtonNewJoinGroupWithMnemonic,
121
122-- * Methods
123  radioButtonSetGroup,
124  radioButtonGetGroup,
125
126-- * Attributes
127  radioButtonGroup,
128
129-- * Signals
130#if GTK_CHECK_VERSION(2,4,0)
131  groupChanged,
132#endif
133
134-- * Deprecated
135#ifndef DISABLE_DEPRECATED
136#if GTK_CHECK_VERSION(2,4,0)
137  onGroupChanged,
138  afterGroupChanged,
139#endif
140#endif
141  ) where
142
143import Control.Monad    (liftM)
144
145import System.Glib.FFI
146import System.Glib.UTFString
147import System.Glib.GList
148import System.Glib.Attributes
149import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
150{#import Graphics.UI.Gtk.Types#}
151{#import Graphics.UI.Gtk.Signals#}
152
153{# context lib="gtk" prefix="gtk" #}
154
155--------------------
156-- Constructors
157
158-- | Creates a new 'RadioButton' with a new group. To be of any practical
159-- value, a widget should then be packed into the radio button.
160--
161radioButtonNew :: IO RadioButton
162radioButtonNew =
163  makeNewObject mkRadioButton $
164  liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $
165  {# call unsafe radio_button_new #}
166    nullPtr
167
168-- | Creates a new 'RadioButton' with a text label.
169--
170radioButtonNewWithLabel :: GlibString string => string -> IO RadioButton
171radioButtonNewWithLabel label =
172  makeNewObject mkRadioButton $
173  liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $
174  withUTFString label $ \labelPtr ->
175  {# call unsafe radio_button_new_with_label #}
176    nullPtr
177    labelPtr
178
179-- | Creates a new 'RadioButton' containing a label. The label will be created
180-- using 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic',
181-- so underscores in @label@ indicate the mnemonic
182-- for the button.
183--
184radioButtonNewWithMnemonic :: GlibString string
185 => string         -- ^ @label@ - the text of the button, with an underscore
186                   -- in front of the mnemonic character
187 -> IO RadioButton
188radioButtonNewWithMnemonic label =
189  makeNewObject mkRadioButton $
190  liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $
191  withUTFString label $ \labelPtr ->
192  {# call unsafe radio_button_new_with_mnemonic #}
193    nullPtr
194    labelPtr
195
196-- | Creates a new 'RadioButton', adding it to the same group as the group to
197-- which @groupMember@ belongs. As with 'radioButtonNew', a widget should be
198-- packed into the radio button.
199--
200radioButtonNewFromWidget ::
201    RadioButton    -- ^ @groupMember@ - a member of an existing radio button
202                   -- group, to which the new radio button will be added.
203 -> IO RadioButton
204radioButtonNewFromWidget group =
205  makeNewObject mkRadioButton $
206  liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $
207  {# call radio_button_new_from_widget #}
208    group
209
210-- | Creates a new 'RadioButton' with a text label, adding it to the same group
211-- as the group to which @groupMember@ belongs.
212--
213radioButtonNewWithLabelFromWidget :: GlibString string
214 => RadioButton    -- ^ @groupMember@ - a member of an existing radio button
215                   -- group, to which the new radio button will be added.
216 -> string         -- ^ @label@ - a text string to display next to the radio
217                   -- button.
218 -> IO RadioButton
219radioButtonNewWithLabelFromWidget group label =
220  makeNewObject mkRadioButton $
221  liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $
222  withUTFString label $ \labelPtr ->
223  {# call radio_button_new_with_label_from_widget #}
224    group
225    labelPtr
226
227-- | Creates a new 'RadioButton' containing a label, adding it to the same group
228-- as the group to which @groupMember@ belongs. The label will be created using
229-- 'Graphics.UI.Gtk.Display.Label.labelNewWithMnemonic',
230-- so underscores in @label@ indicate the mnemonic for the button.
231--
232radioButtonNewWithMnemonicFromWidget :: GlibString string
233 => RadioButton    -- ^ @groupMember@ - a member of an existing radio button
234                   -- group, to which the new radio button will be added.
235 -> string         -- ^ @label@ - the text of the button, with an underscore
236                   -- in front of the mnemonic character
237 -> IO RadioButton
238radioButtonNewWithMnemonicFromWidget group label =
239  makeNewObject mkRadioButton $
240  liftM (castPtr :: Ptr Widget -> Ptr RadioButton) $
241  withUTFString label $ \labelPtr ->
242  {# call radio_button_new_with_mnemonic_from_widget #}
243    group
244    labelPtr
245
246-- | Alias for 'radioButtonNewFromWidget'.
247radioButtonNewJoinGroup ::
248    RadioButton    -- ^ @groupMember@ - a member of an existing radio button
249                   -- group, to which the new radio button will be added.
250 -> IO RadioButton
251radioButtonNewJoinGroup = radioButtonNewFromWidget
252{-# DEPRECATED radioButtonNewJoinGroup "use radioButtonNewFromWidget instead" #-}
253
254-- | Alias for 'radioButtonNewWithLabelFromWidget'.
255radioButtonNewJoinGroupWithLabel :: GlibString string
256 => RadioButton    -- ^ @groupMember@ - a member of an existing radio button
257                   -- group, to which the new radio button will be added.
258 -> string         -- ^ @label@ - a text string to display next to the radio
259                   -- button.
260 -> IO RadioButton
261radioButtonNewJoinGroupWithLabel = radioButtonNewWithLabelFromWidget
262{-# DEPRECATED radioButtonNewJoinGroupWithLabel "use radioButtonNewWithLabelFromWidget instead" #-}
263
264-- | Alias for 'radioButtonNewWithMnemonicFromWidget'.
265radioButtonNewJoinGroupWithMnemonic :: GlibString string
266 => RadioButton    -- ^ @groupMember@ - a member of an existing radio button
267                   -- group, to which the new radio button will be added.
268 -> string         -- ^ @label@ - the text of the button, with an underscore
269                   -- in front of the mnemonic character
270 -> IO RadioButton
271radioButtonNewJoinGroupWithMnemonic = radioButtonNewWithMnemonicFromWidget
272{-# DEPRECATED radioButtonNewJoinGroupWithMnemonic "use radioButtonNewWithMnemonicFromWidget instead" #-}
273
274--------------------
275-- Methods
276
277-- | Sets a 'RadioButton's group. It should be noted that this does not
278-- change the layout of your interface in any way, so if you are changing the
279-- group, it is likely you will need to re-arrange the user interface to
280-- reflect these changes.
281--
282radioButtonSetGroup :: RadioButton
283 -> RadioButton -- ^ @groupMember@ - a member of an existing radio button group,
284                -- to which this radio button will be added.
285 -> IO ()
286radioButtonSetGroup self group =
287  {# call unsafe gtk_radio_button_get_group #} group >>= \groupGSList ->
288  {# call gtk_radio_button_set_group #}
289    self
290    groupGSList
291
292-- | Retrieves the group assigned to a radio button.
293--
294radioButtonGetGroup :: RadioButton
295 -> IO [RadioButton] -- ^ returns a list containing all the radio buttons
296                     -- in the same group as this radio button.
297radioButtonGetGroup self =
298  {# call unsafe gtk_radio_button_get_group #}
299    self
300  >>= readGSList
301  >>= mapM (\elemPtr -> makeNewObject mkRadioButton (return elemPtr))
302
303--------------------
304-- Attributes
305
306-- | Sets a new group for a radio button.
307--
308radioButtonGroup :: ReadWriteAttr RadioButton [RadioButton] RadioButton
309radioButtonGroup = newAttr
310  radioButtonGetGroup
311  radioButtonSetGroup
312
313--------------------
314-- Signals
315
316#if GTK_CHECK_VERSION(2,4,0)
317-- %hash c:be94 d:a584
318-- | Emitted when the group of radio buttons that a radio button belongs to
319-- changes. This is emitted when a radio button switches from being alone to
320-- being part of a group of 2 or more buttons, or vice-versa, and when a
321-- buttton is moved from one group of 2 or more buttons to a different one, but
322-- not when the composition of the group that a button belongs to changes.
323--
324-- * Available since Gtk+ version 2.4
325--
326groupChanged :: RadioButtonClass self => Signal self (IO ())
327groupChanged = Signal (connect_NONE__NONE "group-changed")
328#endif
329
330--------------------
331-- Deprecated Signals
332
333#ifndef DISABLE_DEPRECATED
334
335#if GTK_CHECK_VERSION(2,4,0)
336-- | Emitted when the group of radio buttons that a radio button belongs to
337-- changes. This is emitted when a radio button switches from being alone to
338-- being part of a group of 2 or more buttons, or vice-versa, and when a
339-- buttton is moved from one group of 2 or more buttons to a different one, but
340-- not when the composition of the group that a button belongs to changes.
341--
342onGroupChanged, afterGroupChanged :: RadioButtonClass self => self
343 -> IO ()
344 -> IO (ConnectId self)
345onGroupChanged = connect_NONE__NONE "group-changed" False
346afterGroupChanged = connect_NONE__NONE "group-changed" True
347#endif
348#endif
349