{-# LINE 2 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Tooltips
--
-- Author : Axel Simon
--
-- Created: 23 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- 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)
--
-- Add tips to your widgets
--
module Graphics.UI.Gtk.Misc.Tooltips (
-- * Detail
--
-- | Tooltips are the messages that appear next to a widget when the mouse
-- pointer is held over it for a short amount of time. They are especially
-- helpful for adding more verbose descriptions of things such as buttons in a
-- toolbar.
--
-- An individual tooltip belongs to a group of tooltips. A group is created
-- with a call to 'tooltipsNew'. Every tooltip in the group can then be turned
-- off with a call to 'tooltipsDisable' and enabled with 'tooltipsEnable'.
--

-- The length of time the user must keep the mouse over a widget before the
-- tip is shown, can be altered with 'tooltipsSetDelay'. This is set on a \'per
-- group of tooltips\' basis.
--

-- To assign a tip to a particular 'Widget', 'tooltipsSetTip' is used.
--
-- To associate 'Tooltips' to a widget it is has to have its own 'DrawWindow'.
-- Otherwise the widget must be set into an 'EventBox'.
--
-- The default appearance of all tooltips in a program is determined by the
-- current Gtk+ theme that the user has selected.
--
-- Information about the tooltip (if any) associated with an arbitrary
-- widget can be retrieved using 'tooltipsDataGet'.
--
-- * This module is deprecated. It is empty in Gtk3.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----Tooltips
-- @

-- * Types
  Tooltips,
  TooltipsClass,
  castToTooltips, gTypeTooltips,
  toTooltips,

-- * Constructors
  tooltipsNew,

-- * Methods
  tooltipsEnable,
  tooltipsDisable,

  tooltipsSetDelay,

  tooltipsSetTip,
  tooltipsDataGet

  ) where


import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 92 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}


{-# LINE 94 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}

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

-- | Create a new group of 'Tooltips'.
--
tooltipsNew :: IO Tooltips
tooltipsNew :: IO Tooltips
tooltipsNew =
  (ForeignPtr Tooltips -> Tooltips, FinalizerPtr Tooltips)
-> IO (Ptr Tooltips) -> IO Tooltips
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Tooltips -> Tooltips, FinalizerPtr Tooltips)
forall {a}. (ForeignPtr Tooltips -> Tooltips, FinalizerPtr a)
mkTooltips (IO (Ptr Tooltips) -> IO Tooltips)
-> IO (Ptr Tooltips) -> IO Tooltips
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Tooltips)
gtk_tooltips_new
{-# LINE 104 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}

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

-- | Allows the user to see your tooltips as they navigate your application.
--
tooltipsEnable :: TooltipsClass self => self -> IO ()
tooltipsEnable :: forall self. TooltipsClass self => self -> IO ()
tooltipsEnable self
self =
  (\(Tooltips ForeignPtr Tooltips
arg1) -> ForeignPtr Tooltips -> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Tooltips
arg1 ((Ptr Tooltips -> IO ()) -> IO ())
-> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Tooltips
argPtr1 ->Ptr Tooltips -> IO ()
gtk_tooltips_enable Ptr Tooltips
argPtr1)
{-# LINE 113 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}
    (toTooltips self)

-- | Causes all tooltips in @tooltips@ to become inactive. Any widgets that
-- have tips associated with that group will no longer display their tips until
-- they are enabled again with 'tooltipsEnable'.
--
tooltipsDisable :: TooltipsClass self => self -> IO ()
tooltipsDisable :: forall self. TooltipsClass self => self -> IO ()
tooltipsDisable self
self =
  (\(Tooltips ForeignPtr Tooltips
arg1) -> ForeignPtr Tooltips -> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Tooltips
arg1 ((Ptr Tooltips -> IO ()) -> IO ())
-> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Tooltips
argPtr1 ->Ptr Tooltips -> IO ()
gtk_tooltips_disable Ptr Tooltips
argPtr1)
{-# LINE 122 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}
    (toTooltips self)


-- | Sets the time between the user moving the mouse over a widget and the
-- widget's tooltip appearing.
--
-- * Warning: this function is deprecated and should not be used in
-- newly-written code.
--
tooltipsSetDelay :: TooltipsClass self => self
 -> Int -- ^ @delay@ - the delay in milliseconds
 -> IO ()
tooltipsSetDelay :: forall self. TooltipsClass self => self -> Int -> IO ()
tooltipsSetDelay self
self Int
delay =
  (\(Tooltips ForeignPtr Tooltips
arg1) CUInt
arg2 -> ForeignPtr Tooltips -> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Tooltips
arg1 ((Ptr Tooltips -> IO ()) -> IO ())
-> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Tooltips
argPtr1 ->Ptr Tooltips -> CUInt -> IO ()
gtk_tooltips_set_delay Ptr Tooltips
argPtr1 CUInt
arg2)
{-# LINE 136 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}
    (toTooltips self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
delay)


-- | Adds a tooltip containing the message @tipText@ to the specified
-- 'Widget'.
--
tooltipsSetTip :: (TooltipsClass self, WidgetClass widget, GlibString string) => self
 -> widget -- ^ @widget@ - the 'Widget' you wish to associate the tip with.
 -> string -- ^ @tipText@ - a string containing the tip itself.
 -> string -- ^ @tipPrivate@ - a string of any further information that may be
           -- useful if the user gets stuck.
 -> IO ()
tooltipsSetTip :: forall self widget string.
(TooltipsClass self, WidgetClass widget, GlibString string) =>
self -> widget -> string -> string -> IO ()
tooltipsSetTip self
self widget
widget string
tipText string
tipPrivate =
  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
tipPrivate ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
tipPrivatePtr ->
  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
tipText ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
tipTextPtr ->
  (\(Tooltips ForeignPtr Tooltips
arg1) (Widget ForeignPtr Widget
arg2) CString
arg3 CString
arg4 -> ForeignPtr Tooltips -> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Tooltips
arg1 ((Ptr Tooltips -> IO ()) -> IO ())
-> (Ptr Tooltips -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Tooltips
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 Tooltips -> Ptr Widget -> CString -> CString -> IO ()
gtk_tooltips_set_tip Ptr Tooltips
argPtr1 Ptr Widget
argPtr2 CString
arg3 CString
arg4)
{-# LINE 153 "./Graphics/UI/Gtk/Misc/Tooltips.chs" #-}
    (toTooltips self)
    (widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)
    CString
tipTextPtr
    CString
tipPrivatePtr

-- | Retrieves any 'Tooltips' previously associated with the given widget.
--
tooltipsDataGet :: (WidgetClass w, GlibString string) => w -> IO (Maybe (Tooltips, string, string))
tooltipsDataGet :: forall w string.
(WidgetClass w, GlibString string) =>
w -> IO (Maybe (Tooltips, string, string))
tooltipsDataGet w
w = do
  Ptr ()
tipDataPtr <- (\(Widget ForeignPtr Widget
arg1) -> ForeignPtr Widget -> (Ptr Widget -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg1 ((Ptr Widget -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr Widget -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr1 ->Ptr Widget -> IO (Ptr ())
gtk_tooltips_data_get Ptr Widget
argPtr1) (w -> Widget
forall o. WidgetClass o => o -> Widget
toWidget w
w)
  if Ptr ()
tipDataPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
    then Maybe (Tooltips, string, string)
-> IO (Maybe (Tooltips, string, string))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Tooltips, string, string)
forall a. Maybe a
Nothing
    else do --next line is a hack, tooltips struct member is at offset 0
           Tooltips
tooltips <- (ForeignPtr Tooltips -> Tooltips, FinalizerPtr Tooltips)
-> IO (Ptr Tooltips) -> IO Tooltips
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Tooltips -> Tooltips, FinalizerPtr Tooltips)
forall {a}. (ForeignPtr Tooltips -> Tooltips, FinalizerPtr a)
mkTooltips (Ptr Tooltips -> IO (Ptr Tooltips)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Tooltips -> IO (Ptr Tooltips))
-> Ptr Tooltips -> IO (Ptr Tooltips)
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr Tooltips
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
tipDataPtr)
           string
tipText <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
ptr Int
16 ::IO (Ptr CChar)}) Ptr ()
tipDataPtr
                   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
           string
tipPrivate <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
ptr Int
24 ::IO (Ptr CChar)}) Ptr ()
tipDataPtr
                     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
           Maybe (Tooltips, string, string)
-> IO (Maybe (Tooltips, string, string))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Tooltips, string, string)
 -> IO (Maybe (Tooltips, string, string)))
-> Maybe (Tooltips, string, string)
-> IO (Maybe (Tooltips, string, string))
forall a b. (a -> b) -> a -> b
$ (Tooltips, string, string) -> Maybe (Tooltips, string, string)
forall a. a -> Maybe a
Just ((Tooltips, string, string) -> Maybe (Tooltips, string, string))
-> (Tooltips, string, string) -> Maybe (Tooltips, string, string)
forall a b. (a -> b) -> a -> b
$ (Tooltips
tooltips, string
tipText, string
tipPrivate)

foreign import ccall unsafe "gtk_tooltips_new"
  gtk_tooltips_new :: (IO (Ptr Tooltips))

foreign import ccall unsafe "gtk_tooltips_enable"
  gtk_tooltips_enable :: ((Ptr Tooltips) -> (IO ()))

foreign import ccall unsafe "gtk_tooltips_disable"
  gtk_tooltips_disable :: ((Ptr Tooltips) -> (IO ()))

foreign import ccall unsafe "gtk_tooltips_set_delay"
  gtk_tooltips_set_delay :: ((Ptr Tooltips) -> (CUInt -> (IO ())))

foreign import ccall unsafe "gtk_tooltips_set_tip"
  gtk_tooltips_set_tip :: ((Ptr Tooltips) -> ((Ptr Widget) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ())))))

foreign import ccall unsafe "gtk_tooltips_data_get"
  gtk_tooltips_data_get :: ((Ptr Widget) -> (IO (Ptr ())))