{-# LANGUAGE CPP #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget ActionGroup -- -- Author : Duncan Coutts -- -- Created: 6 April 2005 -- -- Copyright (C) 2005 Duncan Coutts -- -- 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) -- -- A group of actions -- -- * Module available since Gtk+ version 2.4 -- module Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup ( -- * Detail -- -- | Actions are organised into groups. An action group is essentially a map -- from names to 'Action' objects. -- -- All actions that would make sense to use in a particular context should -- be in a single group. Multiple action groups may be used for a particular -- user interface. In fact, it is expected that most nontrivial applications -- will make use of multiple groups. For example, in an application that can -- edit multiple documents, one group holding global actions (e.g. quit, about, -- new), and one group per document holding actions that act on that document -- (eg. save, cut\/copy\/paste, etc). Each window's menus would be constructed -- from a combination of two action groups. -- -- Accelerators are handled by the Gtk+ accelerator map. All actions are -- assigned an accelerator path (which normally has the form -- @\\/group-name\/action-name@) and a shortcut is associated with -- this accelerator path. All menuitems and toolitems take on this accelerator -- path. The Gtk+ accelerator map code makes sure that the correct shortcut is -- displayed next to the menu item. -- * Class Hierarchy -- | -- @ -- | 'GObject' -- | +----ActionGroup -- @ #if GTK_CHECK_VERSION(2,4,0) -- * Types ActionGroup, ActionGroupClass, castToActionGroup, gTypeActionGroup, toActionGroup, ActionEntry(..), ToggleActionEntry(..), RadioActionEntry(..), -- * Constructors actionGroupNew, -- * Methods actionGroupGetName, actionGroupGetSensitive, actionGroupSetSensitive, actionGroupGetVisible, actionGroupSetVisible, actionGroupGetAction, actionGroupListActions, actionGroupAddAction, actionGroupAddActionWithAccel, actionGroupRemoveAction, actionGroupAddActions, actionGroupAddToggleActions, actionGroupAddRadioActions, actionGroupSetTranslateFunc, actionGroupSetTranslationDomain, #if GTK_CHECK_VERSION(2,6,0) actionGroupTranslateString, #endif -- * Attributes actionGroupName, actionGroupSensitive, actionGroupVisible, -- * Signals -- onConnectProxy, -- afterConnectProxy, -- onDisconnectProxy, -- afterDisconnectProxy, -- onPreActivate, -- afterPreActivate, -- onPostActivate, -- afterPostActivate, #endif ) 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#} import System.Glib.Signals (on) import Graphics.UI.Gtk.ActionMenuToolbar.Action import Graphics.UI.Gtk.ActionMenuToolbar.ToggleAction import Graphics.UI.Gtk.ActionMenuToolbar.RadioAction {# context lib="gtk" prefix="gtk" #} #if GTK_CHECK_VERSION(2,4,0) -------------------- -- Constructors -- | Creates a new 'ActionGroup' object. The name of the action group is used -- when associating keybindings with the actions. -- actionGroupNew :: GlibString string => string -- ^ @name@ - the name of the action group. -> IO ActionGroup actionGroupNew name = wrapNewGObject mkActionGroup $ withUTFString name $ \namePtr -> {# call gtk_action_group_new #} namePtr -------------------- -- Methods -- | Gets the name of the action group. -- actionGroupGetName :: GlibString string => ActionGroup -> IO string -- ^ returns the name of the action group. actionGroupGetName self = {# call gtk_action_group_get_name #} self >>= peekUTFString -- | Returns @True@ if the group is sensitive. The constituent actions can -- only be logically sensitive (see 'actionIsSensitive') if they are sensitive -- (see 'actionGetSensitive') and their group is sensitive. -- actionGroupGetSensitive :: ActionGroup -> IO Bool actionGroupGetSensitive self = liftM toBool $ {# call gtk_action_group_get_sensitive #} self -- | Changes the sensitivity of @actionGroup@ -- actionGroupSetSensitive :: ActionGroup -> Bool -> IO () actionGroupSetSensitive self sensitive = {# call gtk_action_group_set_sensitive #} self (fromBool sensitive) -- | Returns @True@ if the group is visible. The constituent actions can only -- be logically visible (see 'actionIsVisible') if they are visible (see -- 'actionGetVisible') and their group is visible. -- actionGroupGetVisible :: ActionGroup -> IO Bool actionGroupGetVisible self = liftM toBool $ {# call gtk_action_group_get_visible #} self -- | Changes the visible of @actionGroup@. -- actionGroupSetVisible :: ActionGroup -> Bool -> IO () actionGroupSetVisible self visible = {# call gtk_action_group_set_visible #} self (fromBool visible) -- | Looks up an action in the action group by name. -- actionGroupGetAction :: GlibString string => ActionGroup -> string -- ^ @actionName@ - the name of the action -> IO (Maybe Action) -- ^ returns the action, or @Nothing@ if no action by -- that name exists actionGroupGetAction self actionName = maybeNull (makeNewGObject mkAction) $ withUTFString actionName $ \actionNamePtr -> {# call gtk_action_group_get_action #} self actionNamePtr -- | Lists the actions in the action group. -- actionGroupListActions :: ActionGroup -> IO [Action] -- ^ returns a list of the action objects in the action group actionGroupListActions self = {# call gtk_action_group_list_actions #} self >>= fromGList >>= mapM (\elemPtr -> makeNewGObject mkAction (return elemPtr)) -- | Adds an action object to the action group. Note that this function does -- not set up the accel path of the action, which can lead to problems if a -- user tries to modify the accelerator of a menuitem associated with the -- action. Therefore you must either set the accel path yourself with -- 'actionSetAccelPath', or use @'actionGroupAddActionWithAccel' ... Nothing@. -- actionGroupAddAction :: ActionClass action => ActionGroup -> action -> IO () actionGroupAddAction self action = {# call gtk_action_group_add_action #} self (toAction action) -- | Adds an action object to the action group and sets up the accelerator. -- -- If @accelerator@ is @Nothing@, attempts to use the accelerator associated -- with the stock id of the action. -- -- Accel paths are set to @\\/group-name\/action-name@. -- actionGroupAddActionWithAccel :: (ActionClass action, GlibString string) => ActionGroup -> action -- ^ @action@ - the action to add -> Maybe string -- ^ @accelerator@ - the accelerator for the action, in the -- format understood by 'acceleratorParse', or \"\" for no -- accelerator, or @Nothing@ to use the stock accelerator -> IO () actionGroupAddActionWithAccel self action accelerator = maybeWith withUTFString accelerator $ \acceleratorPtr -> {# call gtk_action_group_add_action_with_accel #} self (toAction action) acceleratorPtr -- | Removes an action object from the action group. -- actionGroupRemoveAction :: ActionClass action => ActionGroup -> action -> IO () actionGroupRemoveAction self action = {# call gtk_action_group_remove_action #} self (toAction action) -- Note: for these next few funtions we cannot use the C version because the -- callback doesn't allow for propper memory management. So like pygtk we -- implement them natively since they are only convenience functions afterall. -- | A description of an action. data ActionEntry = ActionEntry { actionEntryName :: DefaultGlibString, actionEntryLabel :: DefaultGlibString, actionEntryStockId :: Maybe DefaultGlibString, actionEntryAccelerator :: Maybe DefaultGlibString, actionEntryTooltip :: Maybe DefaultGlibString, actionEntryCallback :: IO () } -- | This is a convenience function to create a number of actions and add them -- to the action group. -- -- The 'actionActivated' signals of the actions are connected to the callbacks -- and their accel paths are set to @\\/group-name\/action-name@. -- actionGroupAddActions :: ActionGroup -> [ActionEntry] -- ^ @entries@ - a list of action descriptions -> IO () actionGroupAddActions self entries = flip mapM_ entries $ \(ActionEntry name label stockId accelerator tooltip callback) -> do action <- actionNew name label tooltip stockId action `on` actionActivated $ callback actionGroupAddActionWithAccel self action accelerator -- | A description of an action for an entry that can be toggled. data ToggleActionEntry = ToggleActionEntry { toggleActionName :: DefaultGlibString, toggleActionLabel :: DefaultGlibString, toggleActionStockId :: Maybe DefaultGlibString, toggleActionAccelerator :: Maybe DefaultGlibString, toggleActionTooltip :: Maybe DefaultGlibString, toggleActionCallback :: IO (), toggleActionIsActive :: Bool } -- | This is a convenience function to create a number of toggle actions and -- add them to the action group. -- -- The 'actionActivated' signals of the actions are connected to the callbacks -- and their accel paths are set to @\\/group-name\/action-name@. -- actionGroupAddToggleActions :: ActionGroup -> [ToggleActionEntry] -- ^ @entries@ - a list of toggle action descriptions -> IO () actionGroupAddToggleActions self entries = flip mapM_ entries $ \(ToggleActionEntry name label stockId accelerator tooltip callback isActive) -> do action <- toggleActionNew name label tooltip stockId toggleActionSetActive action isActive action `on` actionActivated $ callback actionGroupAddActionWithAccel self action accelerator -- | A description of an action for an entry that provides a multiple choice. data RadioActionEntry = RadioActionEntry { radioActionName :: DefaultGlibString, radioActionLabel :: DefaultGlibString, radioActionStockId :: Maybe DefaultGlibString, radioActionAccelerator :: Maybe DefaultGlibString, radioActionTooltip :: Maybe DefaultGlibString, radioActionValue :: Int } -- | This is a convenience routine to create a group of radio actions and add -- them to the action group. -- -- The 'radioActionChanged' signal of the first radio action is connected to the -- @onChange@ callback and the accel paths of the actions are set to -- @\\/group-name\/action-name@. -- actionGroupAddRadioActions :: ActionGroup -> [RadioActionEntry] -- ^ @entries@ - a list of radio action descriptions -> Int -- ^ @value@ - the value of the action to activate -- initially, or -1 if no action should be activated -> (RadioAction -> IO ()) -- ^ @onChange@ - the callback for the changed signal -> IO () actionGroupAddRadioActions self entries initialValue onChange = do group <- foldM (\group (RadioActionEntry name label stockId accelerator tooltip value) -> do action <- radioActionNew name label tooltip stockId value case group of Nothing -> return () Just group -> radioActionSetGroup action group when (initialValue == value) (toggleActionSetActive action True) actionGroupAddActionWithAccel self action accelerator return (Just action)) Nothing entries case group of Nothing -> return () Just group -> do group `on` radioActionChanged $ onChange return () -- | Sets a function to be used for translating the @label@ and @tooltip@ of -- 'ActionEntry's added by 'actionGroupAddActions'. -- -- If you\'re using \'gettext\', it is enough to set the translation domain -- with 'actionGroupSetTranslationDomain'. -- actionGroupSetTranslateFunc :: GlibString string => ActionGroup -> (string -> IO string) -- ^ @(\label -> ...)@ - a translation function -> IO () actionGroupSetTranslateFunc self func = do funcPtr <- mkTranslateFunc $ \strPtr _ -> do str <- peekUTFString strPtr translatedStr <- func str newUTFString translatedStr {# call gtk_action_group_set_translate_func #} self funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr {#pointer TranslateFunc#} foreign import ccall "wrapper" mkTranslateFunc :: (CString -> Ptr () -> IO CString) -> IO TranslateFunc -- | Sets the translation domain and uses \'dgettext\' for translating the -- @label@ and @tooltip@ of 'ActionEntry's added by 'actionGroupAddActions'. -- -- If you\'re not using \'gettext\' for localization, see -- 'actionGroupSetTranslateFunc'. -- actionGroupSetTranslationDomain :: GlibString string => ActionGroup -> string -- ^ @domain@ - the translation domain to use for \'dgettext\' -- calls -> IO () actionGroupSetTranslationDomain self domain = withUTFString domain $ \domainPtr -> {# call gtk_action_group_set_translation_domain #} self domainPtr #if GTK_CHECK_VERSION(2,6,0) -- | Translates a string. -- -- * Available since Gtk+ version 2.6 -- actionGroupTranslateString :: GlibString string => ActionGroup -> string -- ^ @string@ - a string -> IO string -- ^ returns the translation of @string@ actionGroupTranslateString self string = withUTFString string $ \stringPtr -> {# call gtk_action_group_translate_string #} self stringPtr >>= peekUTFString #endif -------------------- -- Attributes -- | A name for the action group. -- -- Default value: \"\" -- actionGroupName :: GlibString string => Attr ActionGroup string actionGroupName = newAttrFromStringProperty "name" -- | Whether the action group is enabled. -- -- Default value: @True@ -- actionGroupSensitive :: Attr ActionGroup Bool actionGroupSensitive = newAttr actionGroupGetSensitive actionGroupSetSensitive -- | Whether the action group is visible. -- -- Default value: @True@ -- actionGroupVisible :: Attr ActionGroup Bool actionGroupVisible = newAttr actionGroupGetVisible actionGroupSetVisible -------------------- -- Signals {- -- | The connect_proxy signal is emitted after connecting a proxy to an action -- in the group. Note that the proxy may have been connected to a different -- action before. -- -- This is intended for simple customizations for which a custom action -- class would be too clumsy, e.g. showing tooltips for menuitems in the -- statusbar. -- onConnectProxy, afterConnectProxy :: ActionGroupClass self => self -> ({-GtkAction-} -> {-GtkWidget-} -> IO ()) -> IO (ConnectId self) onConnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "connect_proxy" False afterConnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "connect_proxy" True -- | The disconnect_proxy signal is emitted after disconnecting a proxy from -- an action in the group. -- onDisconnectProxy, afterDisconnectProxy :: ActionGroupClass self => self -> ({-GtkAction-} -> {-GtkWidget-} -> IO ()) -> IO (ConnectId self) onDisconnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "disconnect_proxy" False afterDisconnectProxy = connect_{-GtkAction-}_{-GtkWidget-}__NONE "disconnect_proxy" True -- | The pre_activate signal is emitted just before the @action@ in the -- @actionGroup@ is activated -- -- This is intended for 'UIManager' to proxy the signal and provide global -- notification just before any action is activated. -- onPreActivate, afterPreActivate :: ActionGroupClass self => self -> ({-GtkAction-} -> IO ()) -> IO (ConnectId self) onPreActivate = connect_{-GtkAction-}__NONE "pre_activate" False afterPreActivate = connect_{-GtkAction-}__NONE "pre_activate" True -- | The post_activate signal is emitted just after the @action@ in the -- @actionGroup@ is activated -- -- This is intended for 'UIManager' to proxy the signal and provide global -- notification just after any action is activated. -- onPostActivate, afterPostActivate :: ActionGroupClass self => self -> ({-GtkAction-} -> IO ()) -> IO (ConnectId self) onPostActivate = connect_{-GtkAction-}__NONE "post_activate" False afterPostActivate = connect_{-GtkAction-}__NONE "post_activate" True -} #endif