{-# LINE 2 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
module Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup (
ActionGroup,
ActionGroupClass,
castToActionGroup, gTypeActionGroup,
toActionGroup,
ActionEntry(..),
ToggleActionEntry(..),
RadioActionEntry(..),
actionGroupNew,
actionGroupGetName,
actionGroupGetSensitive,
actionGroupSetSensitive,
actionGroupGetVisible,
actionGroupSetVisible,
actionGroupGetAction,
actionGroupListActions,
actionGroupAddAction,
actionGroupAddActionWithAccel,
actionGroupRemoveAction,
actionGroupAddActions,
actionGroupAddToggleActions,
actionGroupAddRadioActions,
actionGroupSetTranslateFunc,
actionGroupSetTranslationDomain,
actionGroupTranslateString,
actionGroupName,
actionGroupSensitive,
actionGroupVisible,
) where
import Control.Monad (liftM, foldM, when)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Types
{-# LINE 117 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
import System.Glib.Signals (on)
import Graphics.UI.Gtk.ActionMenuToolbar.Action
import Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction
import Graphics.UI.Gtk.ActionMenuToolbar.RadioAction
{-# LINE 124 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
actionGroupNew :: GlibString string
=> string
-> IO ActionGroup
actionGroupNew :: forall string. GlibString string => string -> IO ActionGroup
actionGroupNew string
name =
(ForeignPtr ActionGroup -> ActionGroup, FinalizerPtr ActionGroup)
-> IO (Ptr ActionGroup) -> IO ActionGroup
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr ActionGroup -> ActionGroup, FinalizerPtr ActionGroup)
forall {a}. (ForeignPtr ActionGroup -> ActionGroup, FinalizerPtr a)
mkActionGroup (IO (Ptr ActionGroup) -> IO ActionGroup)
-> IO (Ptr ActionGroup) -> IO ActionGroup
forall a b. (a -> b) -> a -> b
$
string -> (CString -> IO (Ptr ActionGroup)) -> IO (Ptr ActionGroup)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
name ((CString -> IO (Ptr ActionGroup)) -> IO (Ptr ActionGroup))
-> (CString -> IO (Ptr ActionGroup)) -> IO (Ptr ActionGroup)
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
CString -> IO (Ptr ActionGroup)
gtk_action_group_new
{-# LINE 139 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
namePtr
actionGroupGetName :: GlibString string => ActionGroup
-> IO string
actionGroupGetName :: forall string. GlibString string => ActionGroup -> IO string
actionGroupGetName ActionGroup
self =
(\(ActionGroup ForeignPtr ActionGroup
arg1) -> ForeignPtr ActionGroup
-> (Ptr ActionGroup -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO CString) -> IO CString)
-> (Ptr ActionGroup -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> IO CString
gtk_action_group_get_name Ptr ActionGroup
argPtr1)
{-# LINE 150 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
IO CString -> (CString -> IO string) -> IO 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
forall s. GlibString s => CString -> IO s
peekUTFString
actionGroupGetSensitive :: ActionGroup -> IO Bool
actionGroupGetSensitive :: ActionGroup -> IO Bool
actionGroupGetSensitive ActionGroup
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
$
(\(ActionGroup ForeignPtr ActionGroup
arg1) -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO CInt) -> IO CInt)
-> (Ptr ActionGroup -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> IO CInt
gtk_action_group_get_sensitive Ptr ActionGroup
argPtr1)
{-# LINE 161 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
actionGroupSetSensitive :: ActionGroup -> Bool -> IO ()
actionGroupSetSensitive :: ActionGroup -> Bool -> IO ()
actionGroupSetSensitive ActionGroup
self Bool
sensitive =
(\(ActionGroup ForeignPtr ActionGroup
arg1) CInt
arg2 -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO ()) -> IO ())
-> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> CInt -> IO ()
gtk_action_group_set_sensitive Ptr ActionGroup
argPtr1 CInt
arg2)
{-# LINE 168 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
sensitive)
actionGroupGetVisible :: ActionGroup -> IO Bool
actionGroupGetVisible :: ActionGroup -> IO Bool
actionGroupGetVisible ActionGroup
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
$
(\(ActionGroup ForeignPtr ActionGroup
arg1) -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO CInt) -> IO CInt)
-> (Ptr ActionGroup -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> IO CInt
gtk_action_group_get_visible Ptr ActionGroup
argPtr1)
{-# LINE 179 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
actionGroupSetVisible :: ActionGroup -> Bool -> IO ()
actionGroupSetVisible :: ActionGroup -> Bool -> IO ()
actionGroupSetVisible ActionGroup
self Bool
visible =
(\(ActionGroup ForeignPtr ActionGroup
arg1) CInt
arg2 -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO ()) -> IO ())
-> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> CInt -> IO ()
gtk_action_group_set_visible Ptr ActionGroup
argPtr1 CInt
arg2)
{-# LINE 186 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
visible)
actionGroupGetAction :: GlibString string => ActionGroup
-> string
-> IO (Maybe Action)
actionGroupGetAction :: forall string.
GlibString string =>
ActionGroup -> string -> IO (Maybe Action)
actionGroupGetAction ActionGroup
self string
actionName =
(IO (Ptr Action) -> IO Action)
-> IO (Ptr Action) -> IO (Maybe Action)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Action -> Action, FinalizerPtr Action)
-> IO (Ptr Action) -> IO Action
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Action -> Action, FinalizerPtr Action)
forall {a}. (ForeignPtr Action -> Action, FinalizerPtr a)
mkAction) (IO (Ptr Action) -> IO (Maybe Action))
-> IO (Ptr Action) -> IO (Maybe Action)
forall a b. (a -> b) -> a -> b
$
string -> (CString -> IO (Ptr Action)) -> IO (Ptr Action)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
actionName ((CString -> IO (Ptr Action)) -> IO (Ptr Action))
-> (CString -> IO (Ptr Action)) -> IO (Ptr Action)
forall a b. (a -> b) -> a -> b
$ \CString
actionNamePtr ->
(\(ActionGroup ForeignPtr ActionGroup
arg1) CString
arg2 -> ForeignPtr ActionGroup
-> (Ptr ActionGroup -> IO (Ptr Action)) -> IO (Ptr Action)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO (Ptr Action)) -> IO (Ptr Action))
-> (Ptr ActionGroup -> IO (Ptr Action)) -> IO (Ptr Action)
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> CString -> IO (Ptr Action)
gtk_action_group_get_action Ptr ActionGroup
argPtr1 CString
arg2)
{-# LINE 199 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
CString
actionNamePtr
actionGroupListActions :: ActionGroup
-> IO [Action]
actionGroupListActions :: ActionGroup -> IO [Action]
actionGroupListActions ActionGroup
self =
(\(ActionGroup ForeignPtr ActionGroup
arg1) -> ForeignPtr ActionGroup
-> (Ptr ActionGroup -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr ActionGroup -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> IO (Ptr ())
gtk_action_group_list_actions Ptr ActionGroup
argPtr1)
{-# LINE 208 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
IO (Ptr ()) -> (Ptr () -> IO [Ptr Action]) -> IO [Ptr Action]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO [Ptr Action]
forall a. Ptr () -> IO [Ptr a]
fromGList
IO [Ptr Action] -> ([Ptr Action] -> IO [Action]) -> IO [Action]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr Action -> IO Action) -> [Ptr Action] -> IO [Action]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Ptr Action
elemPtr -> (ForeignPtr Action -> Action, FinalizerPtr Action)
-> IO (Ptr Action) -> IO Action
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Action -> Action, FinalizerPtr Action)
forall {a}. (ForeignPtr Action -> Action, FinalizerPtr a)
mkAction (Ptr Action -> IO (Ptr Action)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Action
elemPtr))
actionGroupAddAction :: ActionClass action => ActionGroup -> action -> IO ()
actionGroupAddAction :: forall action. ActionClass action => ActionGroup -> action -> IO ()
actionGroupAddAction ActionGroup
self action
action =
(\(ActionGroup ForeignPtr ActionGroup
arg1) (Action ForeignPtr Action
arg2) -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO ()) -> IO ())
-> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg2 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr2 ->Ptr ActionGroup -> Ptr Action -> IO ()
gtk_action_group_add_action Ptr ActionGroup
argPtr1 Ptr Action
argPtr2)
{-# LINE 221 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
(action -> Action
forall o. ActionClass o => o -> Action
toAction action
action)
actionGroupAddActionWithAccel :: (ActionClass action, GlibString string) => ActionGroup
-> action
-> Maybe string
-> IO ()
actionGroupAddActionWithAccel :: forall action string.
(ActionClass action, GlibString string) =>
ActionGroup -> action -> Maybe string -> IO ()
actionGroupAddActionWithAccel ActionGroup
self action
action Maybe string
accelerator =
(string -> (CString -> IO ()) -> IO ())
-> Maybe string -> (CString -> IO ()) -> IO ()
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString Maybe string
accelerator ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
acceleratorPtr ->
(\(ActionGroup ForeignPtr ActionGroup
arg1) (Action ForeignPtr Action
arg2) CString
arg3 -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO ()) -> IO ())
-> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg2 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr2 ->Ptr ActionGroup -> Ptr Action -> CString -> IO ()
gtk_action_group_add_action_with_accel Ptr ActionGroup
argPtr1 Ptr Action
argPtr2 CString
arg3)
{-# LINE 240 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
(action -> Action
forall o. ActionClass o => o -> Action
toAction action
action)
CString
acceleratorPtr
actionGroupRemoveAction :: ActionClass action => ActionGroup -> action -> IO ()
actionGroupRemoveAction :: forall action. ActionClass action => ActionGroup -> action -> IO ()
actionGroupRemoveAction ActionGroup
self action
action =
(\(ActionGroup ForeignPtr ActionGroup
arg1) (Action ForeignPtr Action
arg2) -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO ()) -> IO ())
-> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg2 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr2 ->Ptr ActionGroup -> Ptr Action -> IO ()
gtk_action_group_remove_action Ptr ActionGroup
argPtr1 Ptr Action
argPtr2)
{-# LINE 249 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
(action -> Action
forall o. ActionClass o => o -> Action
toAction action
action)
data ActionEntry = ActionEntry {
ActionEntry -> DefaultGlibString
actionEntryName :: DefaultGlibString,
ActionEntry -> DefaultGlibString
actionEntryLabel :: DefaultGlibString,
ActionEntry -> Maybe DefaultGlibString
actionEntryStockId :: Maybe DefaultGlibString,
ActionEntry -> Maybe DefaultGlibString
actionEntryAccelerator :: Maybe DefaultGlibString,
ActionEntry -> Maybe DefaultGlibString
actionEntryTooltip :: Maybe DefaultGlibString,
ActionEntry -> IO ()
actionEntryCallback :: IO ()
}
actionGroupAddActions :: ActionGroup
-> [ActionEntry]
-> IO ()
actionGroupAddActions :: ActionGroup -> [ActionEntry] -> IO ()
actionGroupAddActions ActionGroup
self [ActionEntry]
entries =
((ActionEntry -> IO ()) -> [ActionEntry] -> IO ())
-> [ActionEntry] -> (ActionEntry -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ActionEntry -> IO ()) -> [ActionEntry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [ActionEntry]
entries ((ActionEntry -> IO ()) -> IO ())
-> (ActionEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ActionEntry DefaultGlibString
name DefaultGlibString
label Maybe DefaultGlibString
stockId
Maybe DefaultGlibString
accelerator Maybe DefaultGlibString
tooltip IO ()
callback) -> do
Action
action <- DefaultGlibString
-> DefaultGlibString
-> Maybe DefaultGlibString
-> Maybe DefaultGlibString
-> IO Action
forall string.
GlibString string =>
string
-> string -> Maybe string -> Maybe DefaultGlibString -> IO Action
actionNew DefaultGlibString
name DefaultGlibString
label Maybe DefaultGlibString
tooltip Maybe DefaultGlibString
stockId
Action
action Action -> Signal Action (IO ()) -> IO () -> IO (ConnectId Action)
forall object callback.
object
-> Signal object callback -> callback -> IO (ConnectId object)
`on` Signal Action (IO ())
forall self. ActionClass self => Signal self (IO ())
actionActivated (IO () -> IO (ConnectId Action)) -> IO () -> IO (ConnectId Action)
forall a b. (a -> b) -> a -> b
$ IO ()
callback
ActionGroup -> Action -> Maybe DefaultGlibString -> IO ()
forall action string.
(ActionClass action, GlibString string) =>
ActionGroup -> action -> Maybe string -> IO ()
actionGroupAddActionWithAccel ActionGroup
self Action
action Maybe DefaultGlibString
accelerator
data ToggleActionEntry = ToggleActionEntry {
ToggleActionEntry -> DefaultGlibString
toggleActionName :: DefaultGlibString,
ToggleActionEntry -> DefaultGlibString
toggleActionLabel :: DefaultGlibString,
ToggleActionEntry -> Maybe DefaultGlibString
toggleActionStockId :: Maybe DefaultGlibString,
ToggleActionEntry -> Maybe DefaultGlibString
toggleActionAccelerator :: Maybe DefaultGlibString,
ToggleActionEntry -> Maybe DefaultGlibString
toggleActionTooltip :: Maybe DefaultGlibString,
ToggleActionEntry -> IO ()
toggleActionCallback :: IO (),
ToggleActionEntry -> Bool
toggleActionIsActive :: Bool
}
actionGroupAddToggleActions :: ActionGroup
-> [ToggleActionEntry]
-> IO ()
actionGroupAddToggleActions :: ActionGroup -> [ToggleActionEntry] -> IO ()
actionGroupAddToggleActions ActionGroup
self [ToggleActionEntry]
entries =
((ToggleActionEntry -> IO ()) -> [ToggleActionEntry] -> IO ())
-> [ToggleActionEntry] -> (ToggleActionEntry -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ToggleActionEntry -> IO ()) -> [ToggleActionEntry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [ToggleActionEntry]
entries ((ToggleActionEntry -> IO ()) -> IO ())
-> (ToggleActionEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ToggleActionEntry DefaultGlibString
name DefaultGlibString
label Maybe DefaultGlibString
stockId
Maybe DefaultGlibString
accelerator Maybe DefaultGlibString
tooltip IO ()
callback Bool
isActive) -> do
ToggleAction
action <- DefaultGlibString
-> DefaultGlibString
-> Maybe DefaultGlibString
-> Maybe DefaultGlibString
-> IO ToggleAction
forall string.
GlibString string =>
string
-> string
-> Maybe string
-> Maybe DefaultGlibString
-> IO ToggleAction
toggleActionNew DefaultGlibString
name DefaultGlibString
label Maybe DefaultGlibString
tooltip Maybe DefaultGlibString
stockId
ToggleAction -> Bool -> IO ()
forall self. ToggleActionClass self => self -> Bool -> IO ()
toggleActionSetActive ToggleAction
action Bool
isActive
ToggleAction
action ToggleAction
-> Signal ToggleAction (IO ())
-> IO ()
-> IO (ConnectId ToggleAction)
forall object callback.
object
-> Signal object callback -> callback -> IO (ConnectId object)
`on` Signal ToggleAction (IO ())
forall self. ActionClass self => Signal self (IO ())
actionActivated (IO () -> IO (ConnectId ToggleAction))
-> IO () -> IO (ConnectId ToggleAction)
forall a b. (a -> b) -> a -> b
$ IO ()
callback
ActionGroup -> ToggleAction -> Maybe DefaultGlibString -> IO ()
forall action string.
(ActionClass action, GlibString string) =>
ActionGroup -> action -> Maybe string -> IO ()
actionGroupAddActionWithAccel ActionGroup
self ToggleAction
action Maybe DefaultGlibString
accelerator
data RadioActionEntry = RadioActionEntry {
RadioActionEntry -> DefaultGlibString
radioActionName :: DefaultGlibString,
RadioActionEntry -> DefaultGlibString
radioActionLabel :: DefaultGlibString,
RadioActionEntry -> Maybe DefaultGlibString
radioActionStockId :: Maybe DefaultGlibString,
RadioActionEntry -> Maybe DefaultGlibString
radioActionAccelerator :: Maybe DefaultGlibString,
RadioActionEntry -> Maybe DefaultGlibString
radioActionTooltip :: Maybe DefaultGlibString,
RadioActionEntry -> Int
radioActionValue :: Int
}
actionGroupAddRadioActions :: ActionGroup
-> [RadioActionEntry]
-> Int
-> (RadioAction -> IO ())
-> IO ()
actionGroupAddRadioActions :: ActionGroup
-> [RadioActionEntry] -> Int -> (RadioAction -> IO ()) -> IO ()
actionGroupAddRadioActions ActionGroup
self [RadioActionEntry]
entries Int
initialValue RadioAction -> IO ()
onChange = do
Maybe RadioAction
group <- (Maybe RadioAction -> RadioActionEntry -> IO (Maybe RadioAction))
-> Maybe RadioAction
-> [RadioActionEntry]
-> IO (Maybe RadioAction)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
(\Maybe RadioAction
group (RadioActionEntry DefaultGlibString
name DefaultGlibString
label Maybe DefaultGlibString
stockId
Maybe DefaultGlibString
accelerator Maybe DefaultGlibString
tooltip Int
value) -> do
RadioAction
action <- DefaultGlibString
-> DefaultGlibString
-> Maybe DefaultGlibString
-> Maybe DefaultGlibString
-> Int
-> IO RadioAction
forall string.
GlibString string =>
string
-> string
-> Maybe string
-> Maybe DefaultGlibString
-> Int
-> IO RadioAction
radioActionNew DefaultGlibString
name DefaultGlibString
label Maybe DefaultGlibString
tooltip Maybe DefaultGlibString
stockId Int
value
case Maybe RadioAction
group of
Maybe RadioAction
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just RadioAction
group -> RadioAction -> RadioAction -> IO ()
forall self groupMember.
(RadioActionClass self, RadioActionClass groupMember) =>
self -> groupMember -> IO ()
radioActionSetGroup RadioAction
action RadioAction
group
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
initialValue Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
value) (RadioAction -> Bool -> IO ()
forall self. ToggleActionClass self => self -> Bool -> IO ()
toggleActionSetActive RadioAction
action Bool
True)
ActionGroup -> RadioAction -> Maybe DefaultGlibString -> IO ()
forall action string.
(ActionClass action, GlibString string) =>
ActionGroup -> action -> Maybe string -> IO ()
actionGroupAddActionWithAccel ActionGroup
self RadioAction
action Maybe DefaultGlibString
accelerator
Maybe RadioAction -> IO (Maybe RadioAction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RadioAction -> Maybe RadioAction
forall a. a -> Maybe a
Just RadioAction
action))
Maybe RadioAction
forall a. Maybe a
Nothing [RadioActionEntry]
entries
case Maybe RadioAction
group of
Maybe RadioAction
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just RadioAction
group -> do
RadioAction
group RadioAction
-> Signal RadioAction (RadioAction -> IO ())
-> (RadioAction -> IO ())
-> IO (ConnectId RadioAction)
forall object callback.
object
-> Signal object callback -> callback -> IO (ConnectId object)
`on` Signal RadioAction (RadioAction -> IO ())
forall self.
RadioActionClass self =>
Signal self (RadioAction -> IO ())
radioActionChanged ((RadioAction -> IO ()) -> IO (ConnectId RadioAction))
-> (RadioAction -> IO ()) -> IO (ConnectId RadioAction)
forall a b. (a -> b) -> a -> b
$ RadioAction -> IO ()
onChange
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
actionGroupSetTranslateFunc :: GlibString string => ActionGroup
-> (string -> IO string)
-> IO ()
actionGroupSetTranslateFunc :: forall string.
GlibString string =>
ActionGroup -> (string -> IO string) -> IO ()
actionGroupSetTranslateFunc ActionGroup
self string -> IO string
func = do
TranslateFunc
funcPtr <- (CString -> Ptr () -> IO CString) -> IO TranslateFunc
mkTranslateFunc ((CString -> Ptr () -> IO CString) -> IO TranslateFunc)
-> (CString -> Ptr () -> IO CString) -> IO TranslateFunc
forall a b. (a -> b) -> a -> b
$ \CString
strPtr Ptr ()
_ -> do
string
str <- CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr
string
translatedStr <- string -> IO string
func string
str
string -> IO CString
forall s. GlibString s => s -> IO CString
newUTFString string
translatedStr
(\(ActionGroup ForeignPtr ActionGroup
arg1) TranslateFunc
arg2 Ptr ()
arg3 FunPtr (Ptr () -> IO ())
arg4 -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO ()) -> IO ())
-> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup
-> TranslateFunc -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO ()
gtk_action_group_set_translate_func Ptr ActionGroup
argPtr1 TranslateFunc
arg2 Ptr ()
arg3 FunPtr (Ptr () -> IO ())
arg4)
{-# LINE 367 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
TranslateFunc
funcPtr
(TranslateFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr TranslateFunc
funcPtr)
FunPtr (Ptr () -> IO ())
destroyFunPtr
type TranslateFunc = FunPtr (((Ptr CChar) -> ((Ptr ()) -> (IO (Ptr CChar)))))
{-# LINE 373 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
foreign import ccall "wrapper" mkTranslateFunc ::
(CString -> Ptr () -> IO CString) -> IO TranslateFunc
actionGroupSetTranslationDomain :: GlibString string => ActionGroup
-> string
-> IO ()
actionGroupSetTranslationDomain :: forall string. GlibString string => ActionGroup -> string -> IO ()
actionGroupSetTranslationDomain ActionGroup
self string
domain =
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
domain ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
domainPtr ->
(\(ActionGroup ForeignPtr ActionGroup
arg1) CString
arg2 -> ForeignPtr ActionGroup -> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO ()) -> IO ())
-> (Ptr ActionGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> CString -> IO ()
gtk_action_group_set_translation_domain Ptr ActionGroup
argPtr1 CString
arg2)
{-# LINE 390 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
CString
domainPtr
actionGroupTranslateString :: GlibString string => ActionGroup
-> string
-> IO string
actionGroupTranslateString :: forall string.
GlibString string =>
ActionGroup -> string -> IO string
actionGroupTranslateString ActionGroup
self string
string =
string -> (CString -> IO string) -> IO string
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
string ((CString -> IO string) -> IO string)
-> (CString -> IO string) -> IO string
forall a b. (a -> b) -> a -> b
$ \CString
stringPtr ->
(\(ActionGroup ForeignPtr ActionGroup
arg1) CString
arg2 -> ForeignPtr ActionGroup
-> (Ptr ActionGroup -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ActionGroup
arg1 ((Ptr ActionGroup -> IO CString) -> IO CString)
-> (Ptr ActionGroup -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr ActionGroup
argPtr1 ->Ptr ActionGroup -> CString -> IO CString
gtk_action_group_translate_string Ptr ActionGroup
argPtr1 CString
arg2)
{-# LINE 404 "./Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs" #-}
self
CString
stringPtr
IO CString -> (CString -> IO string) -> IO 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
forall s. GlibString s => CString -> IO s
peekUTFString
actionGroupName :: GlibString string => Attr ActionGroup string
actionGroupName :: forall string. GlibString string => Attr ActionGroup string
actionGroupName = String -> Attr ActionGroup string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"name"
actionGroupSensitive :: Attr ActionGroup Bool
actionGroupSensitive :: Attr ActionGroup Bool
actionGroupSensitive = (ActionGroup -> IO Bool)
-> (ActionGroup -> Bool -> IO ()) -> Attr ActionGroup Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
ActionGroup -> IO Bool
actionGroupGetSensitive
ActionGroup -> Bool -> IO ()
actionGroupSetSensitive
actionGroupVisible :: Attr ActionGroup Bool
actionGroupVisible :: Attr ActionGroup Bool
actionGroupVisible = (ActionGroup -> IO Bool)
-> (ActionGroup -> Bool -> IO ()) -> Attr ActionGroup Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
ActionGroup -> IO Bool
actionGroupGetVisible
ActionGroup -> Bool -> IO ()
actionGroupSetVisible
foreign import ccall safe "gtk_action_group_new"
gtk_action_group_new :: ((Ptr CChar) -> (IO (Ptr ActionGroup)))
foreign import ccall safe "gtk_action_group_get_name"
gtk_action_group_get_name :: ((Ptr ActionGroup) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_action_group_get_sensitive"
gtk_action_group_get_sensitive :: ((Ptr ActionGroup) -> (IO CInt))
foreign import ccall safe "gtk_action_group_set_sensitive"
gtk_action_group_set_sensitive :: ((Ptr ActionGroup) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_action_group_get_visible"
gtk_action_group_get_visible :: ((Ptr ActionGroup) -> (IO CInt))
foreign import ccall safe "gtk_action_group_set_visible"
gtk_action_group_set_visible :: ((Ptr ActionGroup) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_action_group_get_action"
gtk_action_group_get_action :: ((Ptr ActionGroup) -> ((Ptr CChar) -> (IO (Ptr Action))))
foreign import ccall safe "gtk_action_group_list_actions"
gtk_action_group_list_actions :: ((Ptr ActionGroup) -> (IO (Ptr ())))
foreign import ccall safe "gtk_action_group_add_action"
gtk_action_group_add_action :: ((Ptr ActionGroup) -> ((Ptr Action) -> (IO ())))
foreign import ccall safe "gtk_action_group_add_action_with_accel"
gtk_action_group_add_action_with_accel :: ((Ptr ActionGroup) -> ((Ptr Action) -> ((Ptr CChar) -> (IO ()))))
foreign import ccall safe "gtk_action_group_remove_action"
gtk_action_group_remove_action :: ((Ptr ActionGroup) -> ((Ptr Action) -> (IO ())))
foreign import ccall safe "gtk_action_group_set_translate_func"
gtk_action_group_set_translate_func :: ((Ptr ActionGroup) -> ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (IO (Ptr CChar))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO ())))))
foreign import ccall safe "gtk_action_group_set_translation_domain"
gtk_action_group_set_translation_domain :: ((Ptr ActionGroup) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_action_group_translate_string"
gtk_action_group_translate_string :: ((Ptr ActionGroup) -> ((Ptr CChar) -> (IO (Ptr CChar))))