[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Display AccelLabel.chs,NONE,1.1 Image.chs,NONE,1.1 Label.chs,NONE,1.1 ProgressBar.chs,NONE,1.1 Statusbar.chs,NONE,1.1

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Display
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31473/gtk/Graphics/UI/Gtk/Display

Added Files:
	AccelLabel.chs Image.chs Label.chs ProgressBar.chs 
	Statusbar.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Image.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Image
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- This widget displays an image.
--
--
-- * Because Haskell is not the best language to modify large images directly
--   only functions are bound that allow loading images from disc or by stock
--   names.
--
-- * Another function for extracting the 'Pixbuf' is added for 
--   'CellRenderer'.
--
-- TODO
--
-- * Figure out what other functions are useful within Haskell. Maybe we should
--   support loading Pixmaps without exposing them.
--
module Graphics.UI.Gtk.Display.Image (
  Image,
  ImageClass,
  castToImage,
  imageNewFromFile,
  IconSize,
  iconSizeMenu,
  iconSizeSmallToolbar,
  iconSizeLargeToolbar,
  iconSizeButton,
  iconSizeDialog,
  imageNewFromStock,
  imageGetPixbuf,
  imageNewFromPixbuf
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import System.Glib.GObject		(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(IconSize, iconSizeInvalid, iconSizeMenu,
					 iconSizeSmallToolbar, iconSizeLargeToolbar,
					 iconSizeButton, iconSizeDialog)

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Create an image by loading a file.
--
imageNewFromFile :: FilePath -> IO Image
imageNewFromFile path = makeNewObject mkImage $ liftM castPtr $ 
  withUTFString path {#call unsafe image_new_from_file#}

-- | Create a set of images by specifying a stock
-- object.
--
imageNewFromStock :: String -> IconSize -> IO Image
imageNewFromStock stock ic = withUTFString stock $ \strPtr -> 
  makeNewObject mkImage $ liftM castPtr $ {#call unsafe image_new_from_stock#}
  strPtr (fromIntegral ic)

-- | Extract the Pixbuf from the 'Image'.
--
imageGetPixbuf :: Image -> IO Pixbuf
imageGetPixbuf img = makeNewGObject mkPixbuf $ liftM castPtr $
  throwIfNull "Image.imageGetPixbuf: The image contains no Pixbuf object." $
  {#call unsafe image_get_pixbuf#} img


-- | Create an 'Image' from a 
-- 'Pixbuf'.
--
imageNewFromPixbuf :: Pixbuf -> IO Image
imageNewFromPixbuf pbuf = makeNewObject mkImage $ liftM castPtr $
  {#call unsafe image_new_from_pixbuf#} pbuf

--- NEW FILE: ProgressBar.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ProgressBar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- The ProgressBar provides a means for an application to keep the user
-- patient while some time intensive task is going on.
--

module Graphics.UI.Gtk.Display.ProgressBar (
  ProgressBar,
  ProgressBarClass,
  castToProgressBar,
  progressBarNew,
  progressBarPulse,
  progressBarSetText,
  progressBarSetFraction,
  progressBarSetPulseStep,
  progressBarGetFraction,
  progressBarGetPulseStep,
  progressBarGetText,
  ProgressBarOrientation(..),
  progressBarSetOrientation,
  progressBarGetOrientation
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(ProgressBarOrientation(..))

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Create a new ProgreeBar.
--
progressBarNew :: IO ProgressBar
progressBarNew  = makeNewObject mkProgressBar $ liftM castPtr $
  {#call unsafe progress_bar_new#}

-- | Indicates that some progress is made, but you
-- don't know how much. Causes the progress bar to enter \`activity mode',
-- where a block bounces back and forth. Each call to
-- 'progressBarPulse' causes the block to move on by a little bit
-- (the amount of movement per pulse is determined by
-- 'progressBarSetPulseStep').
--
progressBarPulse :: ProgressBarClass pb => pb -> IO ()
progressBarPulse pb = {#call unsafe progress_bar_pulse#} (toProgressBar pb)

-- | Causes the given @text@ to appear
-- superimposed on the progress bar.
--
progressBarSetText :: ProgressBarClass pb => pb -> String -> IO ()
progressBarSetText pb text = withUTFString text $
  {#call unsafe progress_bar_set_text#} (toProgressBar pb)

-- | Causes the progress bar to \`fill in' the
-- given fraction of the bar. The fraction should be between 0.0 and 1.0,
-- inclusive.
--
progressBarSetFraction :: ProgressBarClass pb => pb -> Double -> IO ()
progressBarSetFraction pb fraction = {#call unsafe progress_bar_set_fraction#}
  (toProgressBar pb) (realToFrac fraction)

-- | Sets the fraction of total progress bar
-- length to move the bouncing block for each call to progressBarPulse.
--
-- * The @fraction@ parameter must be between 0.0 and 1.0.
--
progressBarSetPulseStep :: ProgressBarClass pb => pb -> Double -> IO ()
progressBarSetPulseStep pb fraction = 
  {#call unsafe progress_bar_set_pulse_step#} (toProgressBar pb) 
  (realToFrac fraction)

-- | Returns the current fraction of the task
-- that has been completed.
--
progressBarGetFraction :: ProgressBarClass pb => pb -> IO Double
progressBarGetFraction pb = liftM realToFrac $ 
  {#call unsafe progress_bar_get_fraction#} (toProgressBar pb)

-- | Returns the current pulseStep of the task
-- that has been completed.
--
progressBarGetPulseStep :: ProgressBarClass pb => pb -> IO Double
progressBarGetPulseStep pb = liftM realToFrac $ 
  {#call unsafe progress_bar_get_pulse_step#} (toProgressBar pb)


-- | Retrieve the text displayed superimposed on the
-- ProgressBar.
--
-- * Returns Nothing if no text was set.
--
progressBarGetText :: ProgressBarClass pb => pb -> IO (Maybe String)
progressBarGetText pb = do
  strPtr <- {#call unsafe progress_bar_get_text#} (toProgressBar pb)
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Causes the progress bar to switch to a
-- different orientation (left-to-right, right-to-left, top-to-bottom, or
-- bottom-to-top).
--
progressBarSetOrientation :: ProgressBarClass pb => pb ->
                             ProgressBarOrientation -> IO ()
progressBarSetOrientation pb orientation = 
  {#call progress_bar_set_orientation#} (toProgressBar pb)
  ((fromIntegral.fromEnum) orientation)

-- | Retrieve the current ProgressBar
-- orientation.
--
progressBarGetOrientation :: ProgressBarClass pb => pb ->
                             IO ProgressBarOrientation
progressBarGetOrientation pb = liftM (toEnum.fromIntegral) $
  {#call unsafe progress_bar_get_orientation#} (toProgressBar pb)



--- NEW FILE: Statusbar.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget StatusBar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- Report messages of minor importance to the user.
--
-- * A Statusbar is usually placed along the bottom of an application's main
--   Window. It may provide a regular commentary of the application's status 
--   (as is usually the case in a web browser, for example), or may be used to
--   simply output a message when the status changes, (when an upload is 
--   complete in an FTP client, for example).
--
-- * Status bars in Gtk+ maintain a stack of messages. The message at the top
--   of the each bar's stack is the one that will currently be displayed.
--   Any messages added to a statusbar's stack must specify a ContextId that
--   is used to uniquely identify the source of a message. This ContextId can
--   be generated by statusbarGetContextId, given a message and the statusbar
--   that it will be added to. Note that messages are stored in a stack, and
--   when choosing which message to display, the stack structure is adhered
--   to, regardless of the context identifier of a message.
--   Messages are added to the bar's stack with statusbarPush. The message at
--   the top of the stack can be removed using statusbarPop. A message can be
--   removed from anywhere in the stack if it's MessageId was recorded at the
--   time it was added. This is done using statusbarRemove.
--

module Graphics.UI.Gtk.Display.Statusbar (
  Statusbar,
  StatusbarClass,
  castToStatusbar,
  statusbarNew,
  statusbarGetContextId,
  statusbarPush,
  statusbarPop,
  statusbarRemove,
  statusbarSetHasResizeGrip,
  statusbarGetHasResizeGrip,
  onTextPopped,
  afterTextPopped,
  onTextPushed,
  afterTextPushed
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Create a new Statusbar.
--
statusbarNew :: IO Statusbar
statusbarNew  = makeNewObject mkStatusbar $ 
  liftM castPtr {#call unsafe statusbar_new#}

type ContextId = {#type guint#}

-- | Given a context description, this function
-- returns a ContextId. This id can be used to later remove entries form the
-- Statusbar.
--
statusbarGetContextId :: StatusbarClass sb => sb -> String -> IO ContextId
statusbarGetContextId sb description = withUTFString description $
  {#call unsafe statusbar_get_context_id#} (toStatusbar sb)


type MessageId = {#type guint#}

-- | Push a new message on the Statusbar stack. It will
-- be displayed as long as it is on top of the stack.
--
statusbarPush :: StatusbarClass sb => sb -> ContextId -> String -> IO MessageId
statusbarPush sb context msg = withUTFString msg $ {#call statusbar_push#}
  (toStatusbar sb) context

-- | Pops the topmost message that has the correct
-- context.
--
statusbarPop :: StatusbarClass sb => sb -> ContextId -> IO ()
statusbarPop sb context = {#call statusbar_pop#} (toStatusbar sb) context

-- | Remove an entry within the stack.
--
statusbarRemove :: StatusbarClass sb => sb -> ContextId -> MessageId -> IO ()
statusbarRemove sb context message = {#call statusbar_remove#} (toStatusbar sb)
  context message

-- | Toggle the displaying of a resize grip.
--
statusbarSetHasResizeGrip :: StatusbarClass sb => sb -> Bool -> IO ()
statusbarSetHasResizeGrip sb set = {#call statusbar_set_has_resize_grip#}
  (toStatusbar sb) (fromBool set)

-- | Query the displaying of the resize grip.
--
statusbarGetHasResizeGrip :: StatusbarClass sb => sb -> IO Bool
statusbarGetHasResizeGrip sb = liftM toBool $
  {#call unsafe statusbar_get_has_resize_grip#} (toStatusbar sb)

-- signals

-- | Called if a message is removed.
--
onTextPopped, afterTextPopped :: StatusbarClass sb => sb ->
                                 (ContextId -> String -> IO ()) ->
                                 IO (ConnectId sb)
onTextPopped = connect_WORD_STRING__NONE "text-popped" False
afterTextPopped = connect_WORD_STRING__NONE "text-popped" True

-- | Called if a message is pushed on top of the
-- stack.
--
onTextPushed, afterTextPushed :: StatusbarClass sb => sb ->
                                 (ContextId -> String -> IO ()) ->
                                 IO (ConnectId sb)
onTextPushed = connect_WORD_STRING__NONE "text-pushed" False
afterTextPushed = connect_WORD_STRING__NONE "text-pushed" True


--- NEW FILE: AccelLabel.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget AccelLabel
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- This widget is a special version of 'Label'. It displays an 
-- accelerator key next to the Label.
--
-- * The key name is not explicitly set but taken from the key that
--   is associated with the activation of another widget.
--

module Graphics.UI.Gtk.Display.AccelLabel (
  AccelLabel,
  AccelLabelClass,
  castToAccelLabel,
  accelLabelNew,
  accelLabelSetAccelWidget,
  accelLabelGetAccelWidget
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Create a new label with an accelerator key.
--
accelLabelNew :: String -> IO AccelLabel
accelLabelNew str = withUTFString str $ \strPtr -> makeNewObject mkAccelLabel $ 
  liftM castPtr $ {#call unsafe accel_label_new#} strPtr

-- | Set the key name from the activation
-- signal of another widget.
--
accelLabelSetAccelWidget :: (AccelLabelClass acl, WidgetClass w) => acl -> w ->
                            IO ()
accelLabelSetAccelWidget acl w = {#call accel_label_set_accel_widget#}
  (toAccelLabel acl) (toWidget w)

-- | Fetches the widget monitored by this accelerator label, or Nothing if it
-- has not bee set.
--
accelLabelGetAccelWidget :: AccelLabelClass acl => acl -> IO (Maybe Widget)
accelLabelGetAccelWidget acl = do
  wPtr <- {#call unsafe accel_label_get_accel_widget#} (toAccelLabel acl)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget (return wPtr)

--- NEW FILE: Label.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Label
--
--  Author : Manuel M. T. Chakravarty,
--	     Axel Simon
--          
--  Created: 2 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:14:30 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- | A label is a piece of static text in a user interface.
--
module Graphics.UI.Gtk.Display.Label (
  Label,
  LabelClass,
  castToLabel,
  labelNew,
  labelNewWithMnemonic,
  labelSetText,
  labelSetLabel,
  labelSetTextWithMnemonic,
  labelSetMarkup,
  labelSetMarkupWithMnemonic,
  labelSetMnemonicWidget,
  labelGetMnemonicWidget,
  KeyVal,
  labelGetMnemonicKeyval,
  labelSetUseMarkup,
  labelGetUseMarkup,
  labelSetUseUnderline,
  labelGetUseUnderline,
  labelGetText,
  labelGetLabel,
--  labelSetAttributes,
  labelSetPattern,
  Justification(..),
  labelSetJustify,
  labelGetJustify,
  labelGetLayout,
  labelSetLineWrap,
  labelGetLineWrap,
  labelSetSelectable,
  labelGetSelectable,
  labelSelectRegion,
  labelGetSelectionBounds,
  labelGetLayoutOffsets
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject   (makeNewGObject)
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(Justification(..))
import Graphics.UI.Gtk.Pango.Markup
{# context lib="gtk" prefix="gtk" #}


-- methods

-- | Create a new label widget.
--
labelNew :: Maybe String -> IO Label
labelNew str = makeNewObject mkLabel $ liftM castPtr $
  case str of
    Nothing    -> {#call label_new#} nullPtr
    (Just str) -> withUTFString str {#call label_new#}

-- | Set the text the label widget shows. 
--
labelSetText :: LabelClass l => l -> String -> IO ()
labelSetText l str =
  withUTFString str $ {#call label_set_text#} (toLabel l)

-- | The label is interpreted as including embedded underlines and\/or Pango
-- markup depending on the markup and underline properties.
--
labelSetLabel :: LabelClass l => l -> String -> IO ()
labelSetLabel l str =
  withUTFString str $ {#call label_set_label#} (toLabel l)

{-
-- | Set the text attributes.
--
-- labelSetAttributes :: LabelClass l => PangoAttrList -> IO ()
-}

-- | Set the label to a markup string.
--
labelSetMarkup :: LabelClass l => l -> Markup -> IO ()
labelSetMarkup l str =
  withUTFString str $ {#call label_set_markup#} (toLabel l)

-- | Set the label to a markup string and interpret keyboard accelerators.
--
labelSetMarkupWithMnemonic :: LabelClass l => l -> Markup -> IO ()
labelSetMarkupWithMnemonic l str =
  withUTFString str $ {#call label_set_markup_with_mnemonic#} (toLabel l)

-- | Underline parts of the text, odd indices of the list represent underlined
-- parts.
--
labelSetPattern :: LabelClass l => l -> [Int] -> IO ()
labelSetPattern l list =
  withUTFString str $ {#call label_set_pattern#} (toLabel l)
  where
    str = concat $ zipWith replicate list (cycle ['_',' '])

-- | Set the justification of the label.
--
labelSetJustify :: LabelClass l => l -> Justification -> IO ()
labelSetJustify l j = 
  {#call label_set_justify#} (toLabel l) ((fromIntegral.fromEnum) j)

-- | Get the justification of the label.
--
labelGetJustify :: LabelClass l => l -> IO Justification
labelGetJustify l =
  liftM (toEnum.fromIntegral) $ {#call unsafe label_get_justify#} (toLabel l)

-- | Gets the "PangoLayout" used to display the label.
--
labelGetLayout :: LabelClass l => l -> IO PangoLayout
labelGetLayout l =
  makeNewGObject mkPangoLayout $ {#call unsafe label_get_layout#} (toLabel l)

-- | Set wether lines should be wrapped (@True@) or truncated (@False@).
--
labelSetLineWrap :: LabelClass l => l -> Bool -> IO ()
labelSetLineWrap l w = {#call label_set_line_wrap#} (toLabel l) (fromBool w)

-- | Returns whether lines in the label are automatically wrapped.
--
labelGetLineWrap :: LabelClass l => l -> IO Bool
labelGetLineWrap l = liftM toBool $
  {#call unsafe label_get_line_wrap#} (toLabel l)

-- | Get starting cooridinates of text rendering.
--
labelGetLayoutOffsets :: LabelClass l => l -> IO (Int,Int)
labelGetLayoutOffsets l =
  alloca (\xPtr ->
    alloca (\yPtr -> do
      {#call unsafe label_get_layout_offsets#} (toLabel l) xPtr yPtr
      x <- peek xPtr
      y <- peek yPtr
      return (fromIntegral x,fromIntegral y)
    )
  )

-- | KeyVal is a synonym for a hot key number.
--
type KeyVal = {#type guint#}

-- | Get the keyval for the underlined character in the label.
--
labelGetMnemonicKeyval :: LabelClass l => l -> IO KeyVal
labelGetMnemonicKeyval l = 
  {#call unsafe label_get_mnemonic_keyval#} (toLabel l)

-- | Get whether the text selectable.
--
labelGetSelectable :: LabelClass l => l -> IO Bool
labelGetSelectable l = liftM toBool $ 
  {#call unsafe label_get_selectable#} (toLabel l)

-- | Sets whether the text of the label contains markup in Pango's text markup
-- language.
--
labelSetUseMarkup :: LabelClass l => l -> Bool -> IO ()
labelSetUseMarkup l useMarkup =
  {#call label_set_use_markup#} (toLabel l) (fromBool useMarkup)

-- | Returns whether the label's text is interpreted as marked up with the
-- Pango text markup language.
--
labelGetUseMarkup :: LabelClass l => l -> IO Bool
labelGetUseMarkup l = liftM toBool $
  {#call unsafe label_get_use_markup#} (toLabel l)

-- | If @True@, an underline in the text indicates the next character should
-- be used for the mnemonic accelerator key.
--
labelSetUseUnderline :: LabelClass l => l -> Bool -> IO ()
labelSetUseUnderline l useUnderline =
  {#call label_set_use_underline#} (toLabel l) (fromBool useUnderline)

-- | Returns whether an embedded underline in the label indicates a mnemonic.
--
labelGetUseUnderline :: LabelClass l => l -> IO Bool
labelGetUseUnderline l = liftM toBool $
  {#call unsafe label_get_use_underline#} (toLabel l)

-- | Get the text stored in the label. This does not include any embedded
-- underlines indicating mnemonics or Pango markup.
--
labelGetText :: LabelClass l => l -> IO String
labelGetText l = {#call unsafe label_get_text#} (toLabel l) >>= peekUTFString

-- | Get the text from a label widget including any embedded underlines
-- indicating mnemonics and Pango markup.
--
labelGetLabel :: LabelClass l => l -> IO String
labelGetLabel l = {#call unsafe label_get_label#} (toLabel l) >>= peekUTFString

-- | Create a new label widget with accelerator key.
--
-- * Each underscore in @str@ is converted into an underlined character in the
--   label. Entering this character will activate the label widget or any other
--   widget set with 'labelSetMnemonicWidget'.
--
labelNewWithMnemonic :: String -> IO Label
labelNewWithMnemonic str = makeNewObject mkLabel $ liftM castPtr $
  withUTFString str {#call label_new_with_mnemonic#}

-- | Select a region in the label.
--
labelSelectRegion :: LabelClass l => l -> Int -> Int -> IO ()
labelSelectRegion l start end = {#call label_select_region#} (toLabel l) 
  (fromIntegral start) (fromIntegral end)

-- | Gets the selected range of characters in the label, if any. If there is
-- a range selected the result is the start and end of the selection as
-- character offsets.
--
labelGetSelectionBounds :: LabelClass l => l -> IO (Maybe (Int, Int))
labelGetSelectionBounds l =
  alloca $ \startPtr -> alloca $ \endPtr -> do
  isSelection <-
    {#call unsafe label_get_selection_bounds#} (toLabel l) startPtr endPtr
  if toBool isSelection
    then do start <- peek startPtr
            end <- peek endPtr
	    return $ Just $ (fromIntegral start, fromIntegral end)
    else return Nothing

-- | Set an explicit widget for which to emit the \"mnemonic_activate\" signal
-- if an underlined character is pressed.
--
labelSetMnemonicWidget :: (LabelClass l, WidgetClass w) => l -> w -> IO ()
labelSetMnemonicWidget l w = 
  {#call unsafe label_set_mnemonic_widget#} (toLabel l) (toWidget w)

-- | Retrieves the target of the mnemonic (keyboard shortcut) of this label,
-- or Nothing if none has been set and the default algorithm will be used.
--
labelGetMnemonicWidget :: LabelClass l => l -> IO (Maybe Widget)
labelGetMnemonicWidget l = do
  widgetPtr <- {#call unsafe label_get_mnemonic_widget#} (toLabel l)
  if widgetPtr == nullPtr
    then return Nothing
    else liftM Just $ makeNewObject mkWidget (return widgetPtr)

-- | Make a label text selectable.
--
labelSetSelectable :: LabelClass l => l -> Bool -> IO ()
labelSetSelectable l s =
  {#call unsafe label_set_selectable#} (toLabel l) (fromBool s)

-- | Set the label to a markup string and interpret keyboard accelerators.
--
labelSetTextWithMnemonic :: LabelClass l => l -> String -> IO ()
labelSetTextWithMnemonic l str =
  withUTFString str $ {#call label_set_text_with_mnemonic#} (toLabel l)