{-# LINE 2 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Action
--
-- Author : Duncan Coutts, Andy Stewart
--
-- Created: 6 April 2005
--
-- Copyright (C) 2005 Duncan Coutts
-- Copyright (C) 2010 Andy Stewart
--
-- 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)
--
-- An action which can be triggered by a menu or toolbar item
--
-- * Module available since Gtk+ version 2.4
--
module Graphics.UI.Gtk.ActionMenuToolbar.Action (
-- * Detail
--
-- | Actions represent operations that the user can be perform, along with
-- some information how it should be presented in the interface. Each action
-- provides methods to create icons, menu items and toolbar items representing
-- itself.
--
-- As well as the callback that is called when the action gets activated,
-- the following also gets associated with the action:
--
-- * a name (not translated, for path lookup)
--
-- * a label (translated, for display)
--
-- * an accelerator
--
-- * whether label indicates a stock id
--
-- * a tooltip (optional, translated)
--
-- * a toolbar label (optional, shorter than label)
--
-- The action will also have some state information:
--
-- * visible (shown\/hidden)
--
-- * sensitive (enabled\/disabled)
--
-- Apart from regular actions, there are toggle actions, which can be
-- toggled between two states and radio actions, of which only one in a group
-- can be in the \"active\" state. Other actions can be implemented as 'Action'
-- subclasses.
--
-- Each action can have one or more proxy menu item, toolbar button or other
-- proxy widgets. Proxies mirror the state of the action (text label, tooltip,
-- icon, visible, sensitive, etc), and should change when the action's state
-- changes. When the proxy is activated, it should activate its action.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----Action
-- | +----'ToggleAction'
-- @


-- * Types
  Action,
  ActionClass,
  castToAction, gTypeAction,
  toAction,

-- * Constructors
  actionNew,

-- * Methods
  actionGetName,
  actionIsSensitive,
  actionGetSensitive,

  actionSetSensitive,

  actionIsVisible,
  actionGetVisible,

  actionSetVisible,

  actionActivate,
  actionCreateMenuItem,
  actionCreateToolItem,

  actionConnectProxy,
  actionDisconnectProxy,

  actionGetProxies,
  actionConnectAccelerator,
  actionDisconnectAccelerator,

  actionGetAccelPath,

  actionSetAccelPath,
  actionSetAccelGroup,

-- * Attributes
  actionName,
  actionLabel,
  actionShortLabel,
  actionTooltip,
  actionStockId,
  actionVisibleHorizontal,

  actionVisibleOverflown,

  actionVisibleVertical,
  actionIsImportant,
  actionHideIfEmpty,

  actionSensitive,
  actionVisible,
  actionAccelPath,


  actionAlwaysShowImage,


-- * Signals
  actionActivated,

-- * Deprecated

  onActionActivate,
  afterActionActivate,


  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 158 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 159 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
import Graphics.UI.Gtk.General.StockItems


{-# LINE 162 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}


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

-- | Creates a new 'Action' object. To add the action to a 'ActionGroup' and
-- set the accelerator for the action, call
-- 'Graphics.UI.Gtk.ActionMenuToolbar.ActionGroup.actionGroupAddActionWithAccel'.
-- See "Graphics.UI.Gtk.ActionMenuToolbar.UIManager#XML-UI" for information on
-- allowed action names.
--
actionNew :: GlibString string
 => string -- ^ @name@ - A unique name for the action
 -> string -- ^ @label@ - the label displayed in menu items and on
                  -- buttons
 -> Maybe string -- ^ @tooltip@ - a tooltip for the action
 -> Maybe StockId -- ^ @stockId@ - the stock icon to display in widgets
                  -- representing the action
 -> IO Action
actionNew :: forall string.
GlibString string =>
string -> string -> Maybe string -> Maybe StockId -> IO Action
actionNew string
name string
label Maybe string
tooltip Maybe StockId
stockId =
  (ForeignPtr Action -> Action, FinalizerPtr Action)
-> IO (Ptr Action) -> IO Action
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Action -> Action, FinalizerPtr Action)
forall {a}. (ForeignPtr Action -> Action, FinalizerPtr a)
mkAction (IO (Ptr Action) -> IO Action) -> IO (Ptr Action) -> IO Action
forall a b. (a -> b) -> a -> b
$
  (StockId -> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action))
-> Maybe StockId
-> (Ptr CChar -> IO (Ptr Action))
-> IO (Ptr Action)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith StockId -> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a. StockId -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString Maybe StockId
stockId ((Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action))
-> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
stockIdPtr ->
  (string -> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action))
-> Maybe string
-> (Ptr CChar -> IO (Ptr Action))
-> IO (Ptr Action)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith string -> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString Maybe string
tooltip ((Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action))
-> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
tooltipPtr ->
  string -> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
label ((Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action))
-> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
labelPtr ->
  string -> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
name ((Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action))
-> (Ptr CChar -> IO (Ptr Action)) -> IO (Ptr Action)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namePtr ->
  Ptr CChar -> Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr Action)
gtk_action_new
{-# LINE 188 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    namePtr
    Ptr CChar
labelPtr
    Ptr CChar
tooltipPtr
    Ptr CChar
stockIdPtr

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

-- | Returns the name of the action.
--
actionGetName :: (ActionClass self, GlibString string) => self -> IO string
actionGetName :: forall self string.
(ActionClass self, GlibString string) =>
self -> IO string
actionGetName self
self =
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action
-> (Ptr Action -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr Action -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO (Ptr CChar)
gtk_action_get_name Ptr Action
argPtr1)
{-# LINE 201 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
  IO (Ptr CChar) -> (Ptr CChar -> 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
>>= Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString

-- | Returns whether the action is effectively sensitive.
--
actionIsSensitive :: ActionClass self => self
 -> IO Bool -- ^ returns @True@ if the action and its associated action group
            -- are both sensitive.
actionIsSensitive :: forall self. ActionClass self => self -> IO Bool
actionIsSensitive 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
$
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO CInt) -> IO CInt)
-> (Ptr Action -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO CInt
gtk_action_is_sensitive Ptr Action
argPtr1)
{-# LINE 212 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)

-- | Returns whether the action itself is sensitive. Note that this doesn't
-- necessarily mean effective sensitivity. See 'actionIsSensitive' for that.
--
actionGetSensitive :: ActionClass self => self
 -> IO Bool -- ^ returns @True@ if the action itself is sensitive.
actionGetSensitive :: forall self. ActionClass self => self -> IO Bool
actionGetSensitive 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
$
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO CInt) -> IO CInt)
-> (Ptr Action -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO CInt
gtk_action_get_sensitive Ptr Action
argPtr1)
{-# LINE 222 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)


-- | Sets the sensitive property of the action to @sensitive@. Note that
-- this doesn't necessarily mean effective sensitivity. See 'actionIsSensitive'
-- for that.
--
-- * Available since Gtk+ version 2.6
--
actionSetSensitive :: ActionClass self => self
 -> Bool -- ^ @sensitive@ - @True@ to make the action sensitive
 -> IO ()
actionSetSensitive :: forall self. ActionClass self => self -> Bool -> IO ()
actionSetSensitive self
self Bool
sensitive =
  (\(Action ForeignPtr Action
arg1) CInt
arg2 -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> CInt -> IO ()
gtk_action_set_sensitive Ptr Action
argPtr1 CInt
arg2)
{-# LINE 236 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
sensitive)


-- | Returns whether the action is effectively visible.
--
actionIsVisible :: ActionClass self => self
 -> IO Bool -- ^ returns @True@ if the action and its associated action group
            -- are both visible.
actionIsVisible :: forall self. ActionClass self => self -> IO Bool
actionIsVisible 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
$
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO CInt) -> IO CInt)
-> (Ptr Action -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO CInt
gtk_action_is_visible Ptr Action
argPtr1)
{-# LINE 248 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)

-- | Returns whether the action itself is visible. Note that this doesn't
-- necessarily mean effective visibility. See 'actionIsSensitive' for that.
--
actionGetVisible :: ActionClass self => self
 -> IO Bool -- ^ returns @True@ if the action itself is visible.
actionGetVisible :: forall self. ActionClass self => self -> IO Bool
actionGetVisible 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
$
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO CInt) -> IO CInt)
-> (Ptr Action -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO CInt
gtk_action_get_visible Ptr Action
argPtr1)
{-# LINE 258 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)


-- | Sets the visible property of the action to @visible@. Note that this
-- doesn't necessarily mean effective visibility. See 'actionIsVisible' for
-- that.
--
-- * Available since Gtk+ version 2.6
--
actionSetVisible :: ActionClass self => self
 -> Bool -- ^ @visible@ - @True@ to make the action visible
 -> IO ()
actionSetVisible :: forall self. ActionClass self => self -> Bool -> IO ()
actionSetVisible self
self Bool
visible =
  (\(Action ForeignPtr Action
arg1) CInt
arg2 -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> CInt -> IO ()
gtk_action_set_visible Ptr Action
argPtr1 CInt
arg2)
{-# LINE 272 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
visible)


-- | Emits the \"activate\" signal on the specified action, if it isn't
-- insensitive. This gets called by the proxy widgets when they get activated.
--
-- It can also be used to manually activate an action.
--
actionActivate :: ActionClass self => self -> IO ()
actionActivate :: forall self. ActionClass self => self -> IO ()
actionActivate self
self =
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO ()
gtk_action_activate Ptr Action
argPtr1)
{-# LINE 284 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)

-- | Creates a menu item widget that proxies for the given action.
--
actionCreateMenuItem :: ActionClass self => self
 -> IO Widget -- ^ returns a menu item connected to the action.
actionCreateMenuItem :: forall self. ActionClass self => self -> IO Widget
actionCreateMenuItem self
self =
  (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget) -> IO (Ptr Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action
-> (Ptr Action -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Action -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO (Ptr Widget)
gtk_action_create_menu_item Ptr Action
argPtr1)
{-# LINE 293 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)

-- | Creates a toolbar item widget that proxies for the given action.
--
actionCreateToolItem :: ActionClass self => self
 -> IO Widget -- ^ returns a toolbar item connected to the action.
actionCreateToolItem :: forall self. ActionClass self => self -> IO Widget
actionCreateToolItem self
self =
  (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget) -> IO (Ptr Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action
-> (Ptr Action -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Action -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO (Ptr Widget)
gtk_action_create_tool_item Ptr Action
argPtr1)
{-# LINE 302 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)


-- | Connects a widget to an action object as a proxy. Synchronises various
-- properties of the action with the widget (such as label text, icon, tooltip,
-- etc), and attaches a callback so that the action gets activated when the
-- proxy widget does.
--
-- If the widget is already connected to an action, it is disconnected
-- first.
--
-- Removed in Gtk3.
actionConnectProxy :: (ActionClass self, WidgetClass proxy) => self
 -> proxy -- ^ @proxy@ - the proxy widget
 -> IO ()
actionConnectProxy :: forall self proxy.
(ActionClass self, WidgetClass proxy) =>
self -> proxy -> IO ()
actionConnectProxy self
self proxy
proxy =
  (\(Action ForeignPtr Action
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
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 Action -> Ptr Widget -> IO ()
gtk_action_connect_proxy Ptr Action
argPtr1 Ptr Widget
argPtr2)
{-# LINE 319 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
    (proxy -> Widget
forall o. WidgetClass o => o -> Widget
toWidget proxy
proxy)

-- | Disconnects a proxy widget from an action.
--
-- Removed in Gtk3.
actionDisconnectProxy :: (ActionClass self, WidgetClass proxy) => self
 -> proxy -- ^ @proxy@ - the proxy widget
 -> IO ()
actionDisconnectProxy :: forall self proxy.
(ActionClass self, WidgetClass proxy) =>
self -> proxy -> IO ()
actionDisconnectProxy self
self proxy
proxy =
  (\(Action ForeignPtr Action
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
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 Action -> Ptr Widget -> IO ()
gtk_action_disconnect_proxy Ptr Action
argPtr1 Ptr Widget
argPtr2)
{-# LINE 330 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
    (proxy -> Widget
forall o. WidgetClass o => o -> Widget
toWidget proxy
proxy)


-- | Returns the proxy widgets for an action.
--
actionGetProxies :: ActionClass self => self -> IO [Widget]
actionGetProxies :: forall self. ActionClass self => self -> IO [Widget]
actionGetProxies self
self =
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr Action -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO (Ptr ())
gtk_action_get_proxies Ptr Action
argPtr1)
{-# LINE 339 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
  IO (Ptr ()) -> (Ptr () -> IO [Ptr Widget]) -> IO [Ptr Widget]
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 Widget]
forall a. Ptr () -> IO [Ptr a]
readGSList
  IO [Ptr Widget] -> ([Ptr Widget] -> IO [Widget]) -> IO [Widget]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr Widget -> IO Widget) -> [Ptr Widget] -> IO [Widget]
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 Widget
elemPtr -> (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
elemPtr))

-- | Installs the accelerator for @action@ if @action@ has an accel path and
-- group. See 'actionSetAccelPath' and 'actionSetAccelGroup'
--
-- Since multiple proxies may independently trigger the installation of the
-- accelerator, the @action@ counts the number of times this function has been
-- called and doesn't remove the accelerator until
-- 'actionDisconnectAccelerator' has been called as many times.
--
actionConnectAccelerator :: ActionClass self => self -> IO ()
actionConnectAccelerator :: forall self. ActionClass self => self -> IO ()
actionConnectAccelerator self
self =
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO ()
gtk_action_connect_accelerator Ptr Action
argPtr1)
{-# LINE 354 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)

-- | Undoes the effect of one call to 'actionConnectAccelerator'.
--
actionDisconnectAccelerator :: ActionClass self => self -> IO ()
actionDisconnectAccelerator :: forall self. ActionClass self => self -> IO ()
actionDisconnectAccelerator self
self =
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO ()
gtk_action_disconnect_accelerator Ptr Action
argPtr1)
{-# LINE 361 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)


-- | Returns the accel path for this action.
--
-- * Available since Gtk+ version 2.6
--
actionGetAccelPath :: (ActionClass self, GlibString string) => self
 -> IO (Maybe string) -- ^ returns the accel path for this action, or
                      -- @Nothing@ if none is set.
actionGetAccelPath :: forall self string.
(ActionClass self, GlibString string) =>
self -> IO (Maybe string)
actionGetAccelPath self
self =
  (\(Action ForeignPtr Action
arg1) -> ForeignPtr Action
-> (Ptr Action -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr Action -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> IO (Ptr CChar)
gtk_action_get_accel_path Ptr Action
argPtr1)
{-# LINE 373 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
  IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe string)) -> IO (Maybe string)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO string) -> Ptr CChar -> IO (Maybe string)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString


-- | Sets the accel path for this action. All proxy widgets associated with
-- the action will have this accel path, so that their accelerators are
-- consistent.
--
actionSetAccelPath :: (ActionClass self, GlibString string) => self
 -> string -- ^ @accelPath@ - the accelerator path
 -> IO ()
actionSetAccelPath :: forall self string.
(ActionClass self, GlibString string) =>
self -> string -> IO ()
actionSetAccelPath self
self string
accelPath =
  string -> (Ptr CChar -> IO ()) -> IO ()
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
accelPath ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
accelPathPtr ->
  (\(Action ForeignPtr Action
arg1) Ptr CChar
arg2 -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->Ptr Action -> Ptr CChar -> IO ()
gtk_action_set_accel_path Ptr Action
argPtr1 Ptr CChar
arg2)
{-# LINE 387 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
    Ptr CChar
accelPathPtr

-- | Sets the 'AccelGroup' in which the accelerator for this action will be
-- installed.
--
actionSetAccelGroup :: ActionClass self => self -> AccelGroup -> IO ()
actionSetAccelGroup :: forall self. ActionClass self => self -> AccelGroup -> IO ()
actionSetAccelGroup self
self AccelGroup
accelGroup =
  (\(Action ForeignPtr Action
arg1) (AccelGroup ForeignPtr AccelGroup
arg2) -> ForeignPtr Action -> (Ptr Action -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Action
arg1 ((Ptr Action -> IO ()) -> IO ()) -> (Ptr Action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Action
argPtr1 ->ForeignPtr AccelGroup -> (Ptr AccelGroup -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr AccelGroup
arg2 ((Ptr AccelGroup -> IO ()) -> IO ())
-> (Ptr AccelGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AccelGroup
argPtr2 ->Ptr Action -> Ptr AccelGroup -> IO ()
gtk_action_set_accel_group Ptr Action
argPtr1 Ptr AccelGroup
argPtr2)
{-# LINE 396 "./Graphics/UI/Gtk/ActionMenuToolbar/Action.chs" #-}
    (toAction self)
    AccelGroup
accelGroup

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

-- | A unique name for the action.
--
-- Default value: \"\"
--
actionName :: GlibString string => ActionClass self => Attr self string
actionName :: forall string self.
(GlibString string, ActionClass self) =>
Attr self string
actionName = String -> Attr self string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"name"

-- | The label used for menu items and buttons that activate this action.
--
-- Default value: \"\"
--
actionLabel :: GlibString string => ActionClass self => Attr self string
actionLabel :: forall string self.
(GlibString string, ActionClass self) =>
Attr self string
actionLabel = String -> Attr self string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"label"

-- | A shorter label that may be used on toolbar buttons.
--
-- Default value: \"\"
--
actionShortLabel :: GlibString string => ActionClass self => Attr self string
actionShortLabel :: forall string self.
(GlibString string, ActionClass self) =>
Attr self string
actionShortLabel = String -> Attr self string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"short-label"

-- | A tooltip for this action.
--
-- Default value: @Nothing@
--
actionTooltip :: GlibString string => ActionClass self => Attr self (Maybe string)
actionTooltip :: forall string self.
(GlibString string, ActionClass self) =>
Attr self (Maybe string)
actionTooltip = String -> Attr self (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty String
"tooltip"

-- | The stock icon displayed in widgets representing this action.
--
-- Default value: @Nothing@
--
actionStockId :: GlibString string => ActionClass self => Attr self (Maybe string)
actionStockId :: forall string self.
(GlibString string, ActionClass self) =>
Attr self (Maybe string)
actionStockId = String -> Attr self (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty String
"stock_id"

-- | Whether the toolbar item is visible when the toolbar is in a horizontal
-- orientation.
--
-- Default value: @True@
--
actionVisibleHorizontal :: ActionClass self => Attr self Bool
actionVisibleHorizontal :: forall self. ActionClass self => Attr self Bool
actionVisibleHorizontal = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"visible-horizontal"


-- | When @True@, toolitem proxies for this action are represented in the
-- toolbar overflow menu.
--
-- Default value: @True@
--
-- * Available since Gtk+ version 2.6
--
actionVisibleOverflown :: ActionClass self => Attr self Bool
actionVisibleOverflown :: forall self. ActionClass self => Attr self Bool
actionVisibleOverflown = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"visible-overflown"


-- | Whether the toolbar item is visible when the toolbar is in a vertical
-- orientation.
--
-- Default value: @True@
--
actionVisibleVertical :: ActionClass self => Attr self Bool
actionVisibleVertical :: forall self. ActionClass self => Attr self Bool
actionVisibleVertical = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"visible-vertical"

-- | Whether the action is considered important. When @True@, toolitem proxies
-- for this action show text in
-- 'Graphics.UI.Gtk.MenuComboToolbar.Toolbar.ToolbarBothHoriz' mode.
--
-- Default value: @False@
--
actionIsImportant :: ActionClass self => Attr self Bool
actionIsImportant :: forall self. ActionClass self => Attr self Bool
actionIsImportant = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"is-important"

-- | When @True@, empty menu proxies for this action are hidden.
--
-- Default value: @True@
--
actionHideIfEmpty :: ActionClass self => Attr self Bool
actionHideIfEmpty :: forall self. ActionClass self => Attr self Bool
actionHideIfEmpty = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"hide-if-empty"


-- | Whether the action is enabled.
--
-- Default value: @True@
--
-- * Available since Gtk+ version 2.6
--
actionSensitive :: ActionClass self => Attr self Bool
actionSensitive :: forall self. ActionClass self => Attr self Bool
actionSensitive = (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. ActionClass self => self -> IO Bool
actionGetSensitive
  self -> Bool -> IO ()
forall self. ActionClass self => self -> Bool -> IO ()
actionSetSensitive

-- | Whether the action is visible.
--
-- Default value: @True@
--
-- * Available since Gtk+ version 2.6
--
actionVisible :: ActionClass self => Attr self Bool
actionVisible :: forall self. ActionClass self => Attr self Bool
actionVisible = (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. ActionClass self => self -> IO Bool
actionGetVisible
  self -> Bool -> IO ()
forall self. ActionClass self => self -> Bool -> IO ()
actionSetVisible

-- | \'accelPath\' property. See 'actionGetAccelPath' and 'actionSetAccelPath'
--
-- * Available since Gtk+ version 2.6
--
actionAccelPath :: GlibString string => ActionClass self => ReadWriteAttr self (Maybe string) string
actionAccelPath :: forall string self.
(GlibString string, ActionClass self) =>
ReadWriteAttr self (Maybe string) string
actionAccelPath = (self -> IO (Maybe string))
-> (self -> string -> IO ())
-> ReadWriteAttr self (Maybe string) string
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO (Maybe string)
forall self string.
(ActionClass self, GlibString string) =>
self -> IO (Maybe string)
actionGetAccelPath
  self -> string -> IO ()
forall self string.
(ActionClass self, GlibString string) =>
self -> string -> IO ()
actionSetAccelPath



-- | If 'True', the action's menu item proxies will ignore the 'menuImages' setting and always show
-- their image, if available.
--
-- Use this property if the menu item would be useless or hard to use without their image.
--
-- Default value: 'False'
--
-- Since 2.20
actionAlwaysShowImage :: ActionClass self => Attr self Bool
actionAlwaysShowImage :: forall self. ActionClass self => Attr self Bool
actionAlwaysShowImage = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"always-show-image"


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

-- %hash c:4608 d:49a3
-- | The \"activate\" signal is emitted when the action is activated.
--
actionActivated :: ActionClass self => Signal self (IO ())
actionActivated :: forall self. ActionClass self => Signal self (IO ())
actionActivated = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate")

--------------------
-- Deprecated Signals


-- | The \"activate\" signal is emitted when the action is activated.
--
onActionActivate, afterActionActivate :: ActionClass self => self
 -> IO ()
 -> IO (ConnectId self)
onActionActivate :: forall self.
ActionClass self =>
self -> IO () -> IO (ConnectId self)
onActionActivate = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate" Bool
False
afterActionActivate :: forall self.
ActionClass self =>
self -> IO () -> IO (ConnectId self)
afterActionActivate = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate" Bool
True

foreign import ccall safe "gtk_action_new"
  gtk_action_new :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO (Ptr Action))))))

foreign import ccall safe "gtk_action_get_name"
  gtk_action_get_name :: ((Ptr Action) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_action_is_sensitive"
  gtk_action_is_sensitive :: ((Ptr Action) -> (IO CInt))

foreign import ccall safe "gtk_action_get_sensitive"
  gtk_action_get_sensitive :: ((Ptr Action) -> (IO CInt))

foreign import ccall safe "gtk_action_set_sensitive"
  gtk_action_set_sensitive :: ((Ptr Action) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_action_is_visible"
  gtk_action_is_visible :: ((Ptr Action) -> (IO CInt))

foreign import ccall safe "gtk_action_get_visible"
  gtk_action_get_visible :: ((Ptr Action) -> (IO CInt))

foreign import ccall safe "gtk_action_set_visible"
  gtk_action_set_visible :: ((Ptr Action) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_action_activate"
  gtk_action_activate :: ((Ptr Action) -> (IO ()))

foreign import ccall safe "gtk_action_create_menu_item"
  gtk_action_create_menu_item :: ((Ptr Action) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_action_create_tool_item"
  gtk_action_create_tool_item :: ((Ptr Action) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_action_connect_proxy"
  gtk_action_connect_proxy :: ((Ptr Action) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_action_disconnect_proxy"
  gtk_action_disconnect_proxy :: ((Ptr Action) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_action_get_proxies"
  gtk_action_get_proxies :: ((Ptr Action) -> (IO (Ptr ())))

foreign import ccall safe "gtk_action_connect_accelerator"
  gtk_action_connect_accelerator :: ((Ptr Action) -> (IO ()))

foreign import ccall safe "gtk_action_disconnect_accelerator"
  gtk_action_disconnect_accelerator :: ((Ptr Action) -> (IO ()))

foreign import ccall safe "gtk_action_get_accel_path"
  gtk_action_get_accel_path :: ((Ptr Action) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_action_set_accel_path"
  gtk_action_set_accel_path :: ((Ptr Action) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_action_set_accel_group"
  gtk_action_set_accel_group :: ((Ptr Action) -> ((Ptr AccelGroup) -> (IO ())))