gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs/glade/Graphics/UI/Gtk - New directory

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

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

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/glade/Graphics/UI/Gtk added to the repository

[Gtk2hs-commit] gtk2hs/glade/Graphics - New directory

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

Update of /cvsroot/gtk2hs/gtk2hs/glade/Graphics
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7425/glade/Graphics

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/glade/Graphics added to the repository

[Gtk2hs-commit] gtk2hs/glade/Graphics/UI - New directory

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

Update of /cvsroot/gtk2hs/gtk2hs/glade/Graphics/UI
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7425/glade/Graphics/UI

Log Message:
Directory /cvsroot/gtk2hs/gtk2hs/glade/Graphics/UI added to the repository

[Gtk2hs-commit] gtk2hs ChangeLog,1.265,1.266

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

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6328

Modified Files:
	ChangeLog 
Log Message:
hierarchical namespace conversion


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.265
retrieving revision 1.266
diff -u -d -r1.265 -r1.266
--- ChangeLog	8 Jan 2005 15:05:12 -0000	1.265
+++ ChangeLog	8 Jan 2005 15:47:08 -0000	1.266
@@ -17,6 +17,131 @@
 	gtk/Graphics/UI/Gtk/Abstract/Separator.hs,
 	gtk/Graphics/UI/Gtk/Abstract/Widget.chs: add abstract category
 
+	* gtk/Graphics/UI/Gtk/Buttons/Button.chs.pp,
+	gtk/Graphics/UI/Gtk/Buttons/CheckButton.chs,
+	gtk/Graphics/UI/Gtk/Buttons/RadioButton.chs,
+	gtk/Graphics/UI/Gtk/Buttons/ToggleButton.chs: button category
+	
+	* gtk/Graphics/UI/Gtk/Display/AccelLabel.chs,
+	gtk/Graphics/UI/Gtk/Display/Image.chs,
+	gtk/Graphics/UI/Gtk/Display/Label.chs,
+	gtk/Graphics/UI/Gtk/Display/ProgressBar.chs,
+	gtk/Graphics/UI/Gtk/Display/Statusbar.chs: display category
+
+	* gtk/Graphics/UI/Gtk/Embedding/Embedding.hsc,
+	gtk/Graphics/UI/Gtk/Embedding/Plug.chs,
+	gtk/Graphics/UI/Gtk/Embedding/Socket.chs: embedding category
+
+	* gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp,
+	gtk/Graphics/UI/Gtk/Entry/Entry.chs.pp,
+	gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp,
+	gtk/Graphics/UI/Gtk/Entry/HScale.chs,
+	gtk/Graphics/UI/Gtk/Entry/SpinButton.chs,
+	gtk/Graphics/UI/Gtk/Entry/VScale.chs: entry category
+
+	* gtk/Graphics/UI/Gtk/Gdk/DrawWindow.hs,
+	gtk/Graphics/UI/Gtk/Gdk/Drawable.chs.pp,
+	gtk/Graphics/UI/Gtk/Gdk/Enums.chs,
+	gtk/Graphics/UI/Gtk/Gdk/Events.hsc,
+	gtk/Graphics/UI/Gtk/Gdk/GC.chs,
+	gtk/Graphics/UI/Gtk/Gdk/Gdk.chs,
+	gtk/Graphics/UI/Gtk/Gdk/Keys.chs,
+	gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs,
+	gtk/Graphics/UI/Gtk/Gdk/Region.chs.pp: gdk category
+
+	* gtk/Graphics/UI/Gtk/General/Enums.chs.pp,
+	gtk/Graphics/UI/Gtk/General/General.chs,
+	gtk/Graphics/UI/Gtk/General/IconFactory.chs.pp,
+	gtk/Graphics/UI/Gtk/General/StockItems.hsc,
+	gtk/Graphics/UI/Gtk/General/Structs.hsc,
+	gtk/Graphics/UI/Gtk/General/Style.chs: general category
+
+	* gtk/Graphics/UI/Gtk/Layout/Alignment.chs.pp,
+	gtk/Graphics/UI/Gtk/Layout/AspectFrame.chs,
+	gtk/Graphics/UI/Gtk/Layout/Expander.chs.pp,
+	gtk/Graphics/UI/Gtk/Layout/Fixed.chs,
+	gtk/Graphics/UI/Gtk/Layout/HBox.chs,
+	gtk/Graphics/UI/Gtk/Layout/HButtonBox.chs,
+	gtk/Graphics/UI/Gtk/Layout/HPaned.chs,
+	gtk/Graphics/UI/Gtk/Layout/Layout.chs,
+	gtk/Graphics/UI/Gtk/Layout/Notebook.chs.pp,
+	gtk/Graphics/UI/Gtk/Layout/Table.chs,
+	gtk/Graphics/UI/Gtk/Layout/VBox.chs,
+	gtk/Graphics/UI/Gtk/Layout/VButtonBox.chs,
+	gtk/Graphics/UI/Gtk/Layout/VPaned.chs: layout category
+
+	* gtk/Graphics/UI/Gtk/MenuComboToolbar/CheckMenuItem.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/Combo.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/ImageMenuItem.chs,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/Menu.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuBar.chs,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuItem.chs,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/MenuShell.chs,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/OptionMenu.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/RadioMenuItem.chs,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/TearoffMenuItem.chs,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/ToolItem.chs.pp,
+	gtk/Graphics/UI/Gtk/MenuComboToolbar/Toolbar.chs.pp: menu combo
+	toolbar	category
+
+	* gtk/Graphics/UI/Gtk/Misc/Adjustment.chs,
+	gtk/Graphics/UI/Gtk/Misc/Calendar.chs.pp,
+	gtk/Graphics/UI/Gtk/Misc/DrawingArea.chs,
+	gtk/Graphics/UI/Gtk/Misc/EventBox.chs.pp,
+	gtk/Graphics/UI/Gtk/Misc/GArrow.chs,
+	gtk/Graphics/UI/Gtk/Misc/HandleBox.chs,
+	gtk/Graphics/UI/Gtk/Misc/SizeGroup.chs,
+	gtk/Graphics/UI/Gtk/Misc/Tooltips.chs.pp,
+	gtk/Graphics/UI/Gtk/Misc/Viewport.chs: misc category
+
+	* gtk/Graphics/UI/Gtk/Multiline/TextBuffer.chs,
+	gtk/Graphics/UI/Gtk/Multiline/TextIter.chs.pp,
+	gtk/Graphics/UI/Gtk/Multiline/TextMark.chs,
+	gtk/Graphics/UI/Gtk/Multiline/TextTag.chs.pp,
+	gtk/Graphics/UI/Gtk/Multiline/TextTagTable.chs,
+	gtk/Graphics/UI/Gtk/Multiline/TextView.chs: multiline category
+	
+	* gtk/Graphics/UI/Gtk/Ornaments/Frame.chs,
+	gtk/Graphics/UI/Gtk/Ornaments/HSeparator.chs,
+	gtk/Graphics/UI/Gtk/Ornaments/VSeparator.chs: ornaments category
+	
+	* gtk/Graphics/UI/Gtk/Pango/Description.chs,
+	gtk/Graphics/UI/Gtk/Pango/Enums.chs,
+	gtk/Graphics/UI/Gtk/Pango/Layout.chs,
+	gtk/Graphics/UI/Gtk/Pango/Markup.hs,
+	gtk/Graphics/UI/Gtk/Pango/Rendering.chs,
+	gtk/Graphics/UI/Gtk/Pango/Types.chs.pp: pango category
+	
+	* gtk/Graphics/UI/Gtk/Scrolling/HScrollbar.chs,
+	gtk/Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs,
+	gtk/Graphics/UI/Gtk/Scrolling/VScrollbar.chs: scrolling category
+	
+	* gtk/Graphics/UI/Gtk/Selectors/ColorSelection.chs,
+	gtk/Graphics/UI/Gtk/Selectors/ColorSelectionDialog.chs,
+	gtk/Graphics/UI/Gtk/Selectors/FileChooser.chs.pp,
+	gtk/Graphics/UI/Gtk/Selectors/FileChooserDialog.chs.pp,
+	gtk/Graphics/UI/Gtk/Selectors/FileChooserWidget.chs.pp,
+	gtk/Graphics/UI/Gtk/Selectors/FontSelection.chs,
+	gtk/Graphics/UI/Gtk/Selectors/FontSelectionDialog.chs: selectors
+	
+	* gtk/Graphics/UI/Gtk/TreeList/CellRenderer.hs,
+	gtk/Graphics/UI/Gtk/TreeList/CellRendererPixbuf.chs,
+	gtk/Graphics/UI/Gtk/TreeList/CellRendererText.chs,
+	gtk/Graphics/UI/Gtk/TreeList/CellRendererToggle.chs,
+	gtk/Graphics/UI/Gtk/TreeList/ListStore.chs.pp,
+	gtk/Graphics/UI/Gtk/TreeList/TreeModel.chs.pp,
+	gtk/Graphics/UI/Gtk/TreeList/TreeModelSort.chs,
+	gtk/Graphics/UI/Gtk/TreeList/TreeSelection.chs,
+	gtk/Graphics/UI/Gtk/TreeList/TreeStore.chs.pp,
+	gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp,
+	gtk/Graphics/UI/Gtk/TreeList/TreeViewColumn.chs: tree list selectors
+	
+	* gtk/Graphics/UI/Gtk/Windows/Dialog.chs,
+	gtk/Graphics/UI/Gtk/Windows/FileSel.chs,
+	gtk/Graphics/UI/Gtk/Windows/Window.chs.pp: windows selectors
+
 2005-01-07 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/ApiGen.hs: several documentation improvements, add

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Windows Dialog.chs,NONE,1.1 FileSel.chs,NONE,1.1 Window.chs.pp,NONE,1.1

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

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

Added Files:
	Dialog.chs FileSel.chs Window.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Dialog.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Dialog
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:37:33 $
--
--  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 dialog is a smaller window that is used to ask the user for input.
--

module Graphics.UI.Gtk.Windows.Dialog (
  Dialog,
  DialogClass,
  castToDialog,
  dialogNew,
  dialogGetUpper,
  dialogGetActionArea,
  dialogRun,
  dialogResponse,
  ResponseId(..),
  dialogAddButton,
  dialogAddActionWidget,
  dialogGetHasSeparator,
  dialogSetDefaultResponse,
  dialogSetHasSeparator,
  dialogSetResponseSensitive,
  onResponse,
  afterResponse
  ) 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.Structs	(dialogGetUpper, dialogGetActionArea, ResponseId(..), fromResponse, toResponse)

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

-- methods

-- | Create a new Dialog.
--
dialogNew :: IO Dialog
dialogNew  = makeNewObject mkDialog $ liftM castPtr {#call unsafe dialog_new#}

-- | Run the dialog by entering a new main loop.
--
-- * The dialog is run until it is either forced to quit (-1 will be returned)
--   or until the user clicks a button (or other widget) in the action area
--   that makes the dialog emit the @response@ signal (the response id
--   of the pressed button will be returned).
--
-- * To force a dialog to quit, call 'dialogResponse' on it.
--
-- * If this function returns the dialog still needs to be destroyed.
--
dialogRun :: DialogClass dc => dc -> IO ResponseId
dialogRun dc = liftM toResponse $ {#call dialog_run#} (toDialog dc)

-- | Emit the @response@ signal on the dialog.
--
-- * This function can be used to add a custom widget to the action area that
--   should close the dialog when activated or to close the dialog otherwise.
--
dialogResponse :: DialogClass dc => dc -> ResponseId -> IO ()
dialogResponse dc resId = 
  {#call dialog_response#} (toDialog dc) (fromResponse resId)

-- | Add a button with a label to the action area.
--
-- * The text may as well refer to a stock object. If such an object exists it
--   is taken as widget.
--
-- * The function returns the Button that resulted from the call.
--
dialogAddButton :: DialogClass dc => dc -> String -> ResponseId -> IO Button
dialogAddButton dc button resId = withUTFString button $ \strPtr -> 
  makeNewObject mkButton $ liftM castPtr $ {#call dialog_add_button#} 
  (toDialog dc) strPtr (fromResponse resId)

-- | Add a widget to the action area. If the
-- widget is put into the activated state @resId@ will be transmitted
-- by the @response@ signal.
--
-- * A widget that cannot be activated and therefore has to emit the response
--   signal manually must be added by packing it into the action area.
--
dialogAddActionWidget :: (DialogClass dc, WidgetClass w) => dc -> w ->
                         ResponseId -> IO ()
dialogAddActionWidget dc child resId = {#call dialog_add_action_widget#}
  (toDialog dc) (toWidget child) (fromResponse resId)

-- | Query if the dialog has a visible horizontal
-- separator.
--
dialogGetHasSeparator :: DialogClass dc => dc -> IO Bool
dialogGetHasSeparator dc = liftM toBool $ 
  {#call unsafe dialog_get_has_separator#} (toDialog dc)

-- | Set the default widget that is to be
-- activated if the user pressed enter. The object is specified by the
-- ResponseId.
--
dialogSetDefaultResponse :: DialogClass dc => dc -> ResponseId -> IO ()
dialogSetDefaultResponse dc resId = {#call dialog_set_default_response#}
  (toDialog dc) (fromResponse resId)

-- | Set the visibility of the horizontal
-- separator.
--
dialogSetHasSeparator :: DialogClass dc => dc -> Bool -> IO ()
dialogSetHasSeparator dc set = {#call dialog_set_has_separator#}
  (toDialog dc) (fromBool set)

-- | Set widgets in the action are to be
-- sensitive or not.
--
dialogSetResponseSensitive :: DialogClass dc => dc -> ResponseId -> Bool ->
                              IO ()
dialogSetResponseSensitive dc resId sensitive = 
  {#call dialog_set_response_sensitive#} (toDialog dc) (fromResponse resId)
  (fromBool sensitive)

-- signals

-- | This signal is sent when a widget in the action
-- area was activated, the dialog is received a destory event or the user
-- calls dialogResponse. It is usually used to terminate the dialog (by
-- dialogRun for example).
--
onResponse, afterResponse :: DialogClass dc => dc -> (ResponseId -> IO ()) ->
                             IO (ConnectId dc)
onResponse dia act = connect_INT__NONE "response" False dia (act . toResponse)
afterResponse dia act = connect_INT__NONE "response" True dia (act . toResponse)

--- NEW FILE: Window.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Window
--
--  Author : Manuel M. T. Chakravarty, Axel Simon
--          
--  Created: 27 April 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:37:33 $
--
--  Copyright (c) 2001 Manuel M. T. Chakravarty, 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.
--
-- |
--
-- TODO
--
-- * missing but possibly useful methods are commented out
--      
module Graphics.UI.Gtk.Windows.Window (
  Window,
  WindowClass,
  castToWindow,
  windowNew,
  windowSetTitle,
  windowSetResizable,
  windowGetResizable,
--  windowAddAccelGroup, 
--  windowRemoveAccelGroup,
  windowActivateFocus,
  windowActivateDefault,
  windowSetModal,
  windowSetDefaultSize,
--  windowSetGeometryHints,
#ifndef DISABLE_DEPRECATED
  windowSetPolicy,
#endif
  windowSetPosition,
  WindowPosition(..),
  windowSetTransientFor,
  windowSetDestroyWithParent,
-- windowListToplevels,
-- windowAddMnemonic,
-- windowRemoveMnemonic,
-- windowSetMnemonicModifier,
  windowDeiconify,
  windowIconify,
  windowMaximize,
  windowUnmaximize,
  windowSetDecorated,
-- windowSetDecorationsHint,
  windowSetFrameDimensions,
-- windowSetFunctionHint,
  windowSetRole,
  windowStick,
  windowUnstick,
  onFrameEvent,
  afterFrameEvent,
  onSetFocus,
  afterSetFocus
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.General.Enums	(WindowType(WindowToplevel), WindowPosition(..))
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.Gdk.Events	(Event, marshalEvent)

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

-- methods

-- | Create a new window of the given type.
--
windowNew :: IO Window
windowNew = makeNewObject mkWindow $ liftM castPtr $
  {#call window_new#} ((fromIntegral.fromEnum) WindowToplevel)

-- | set the title string of the given window
--
windowSetTitle :: WindowClass w => w -> String -> IO ()
windowSetTitle w str = 
  withUTFString str ({#call window_set_title#} (toWindow w))

-- | Sets whether the user can resize a window.
--
-- * Windows are user resizable by default.
--
windowSetResizable :: WindowClass w => w -> Bool -> IO ()
windowSetResizable w res = 
  {#call window_set_resizable#} (toWindow w) (fromBool res)

-- | Retrieve the value set by
-- 'windowSetResizable'.
--
windowGetResizable :: WindowClass w => w -> IO Bool
windowGetResizable w = liftM toBool $ 
  {#call unsafe window_get_resizable#} (toWindow w)

-- | dunno
--
windowActivateFocus :: WindowClass w => w -> IO Bool
windowActivateFocus w = 
  liftM toBool $ {#call window_activate_focus#} (toWindow w)

-- | dunno
--
windowActivateDefault :: WindowClass w => w -> IO Bool
windowActivateDefault w = 
  liftM toBool $ {#call window_activate_default#} (toWindow w)

#ifndef DISABLE_DEPRECATED
{-# DEPRECATED windowSetPolicy "Use windowSetResizable instead." #-}
-- windowSetPolicy: set the window policy
--
windowSetPolicy :: WindowClass w => w -> Bool -> Bool -> Bool -> IO ()
windowSetPolicy w shrink grow auto = {#call window_set_policy#} 
  (toWindow w) (fromBool shrink) (fromBool grow) (fromBool auto)
#endif

-- | make a window application modal
--
windowSetModal :: WindowClass w => w -> Bool -> IO ()
windowSetModal w m = {#call window_set_modal#} (toWindow w) (fromBool m)

-- | set window default size
--
-- * Sets the default size of a window. If the window's \"natural\" size (its
--   size request) is larger than the default, the default will be ignored.
--   More generally, if the default size does not obey the geometry hints for
--   the window ('windowSetGeometryHints' can be used to set these
--   explicitly), the default size will be clamped to the nearest permitted
--   size.
--
-- * Unlike @widgetSetSizeRequest@, which sets a size request for a
--   widget and thus would keep users from shrinking the window, this function
--   only sets the initial size, just as if the user had resized the window
--   themselves. Users can still shrink the window again as they normally
--   would. Setting a default size of -1 means to use the \"natural\" default
--   size (the size request of the window).
--
-- * For more control over a window's initial size and how resizing works,
--   investigate 'windowSetGeometryHints'.
--
-- * For some uses, 'windowResize' is a more appropriate function.
--   'windowResize' changes the current size of the window, rather
--   than the size to be used on initial display. 'windowResize'
--   always affects the window itself, not the geometry widget.The default
--   size of a window only affects the first time a window is shown; if a
--   window is hidden and re-shown, it will remember the size it had prior to
--   hiding, rather than using the default size. Windows can't actually be 0x0
--   in size, they must be at least 1x1, but passing 0 for width and height is
--   OK, resulting in a 1x1 default size.
--
windowSetDefaultSize :: WindowClass w => w -> Int -> Int -> IO ()
windowSetDefaultSize w height width =
  {#call window_set_default_size#} (toWindow w) (fromIntegral height)
  (fromIntegral width)

-- | set the window position policy
--
windowSetPosition :: WindowClass w => w -> WindowPosition -> IO ()
windowSetPosition w pos = 
  {#call window_set_position#} (toWindow w) ((fromIntegral.fromEnum) pos)

-- | set transient window
--
windowSetTransientFor :: (WindowClass win, WindowClass parent) => win ->
                         parent -> IO ()
windowSetTransientFor w p = 
  {#call window_set_transient_for#} (toWindow w) (toWindow p)

-- | destory transient window with parent
--
windowSetDestroyWithParent :: WindowClass w => w -> Bool -> IO ()
windowSetDestroyWithParent w b = 
  {#call window_set_destroy_with_parent#} (toWindow w) (fromBool b)

-- | restore the window
--
windowDeiconify :: WindowClass w => w -> IO ()
windowDeiconify w = {#call window_deiconify#} (toWindow w)

-- | minimize the window
--
windowIconify :: WindowClass w => w -> IO ()
windowIconify w = {#call window_iconify#} (toWindow w)

-- | maximize the window
--
windowMaximize :: WindowClass w => w -> IO ()
windowMaximize w = {#call window_maximize#} (toWindow w)

-- | unmaximize the window
--
windowUnmaximize :: WindowClass w => w -> IO ()
windowUnmaximize w = {#call window_unmaximize#} (toWindow w)

-- | remove the border
--
windowSetDecorated :: WindowClass w => w -> Bool -> IO ()
windowSetDecorated w b =
  {#call window_set_decorated#} (toWindow w) (fromBool b)

-- | set border widths
--
windowSetFrameDimensions :: WindowClass w => w -> Int -> Int -> Int -> Int ->
                            IO ()
windowSetFrameDimensions w left top right bottom =
 {#call window_set_frame_dimensions#} (toWindow w) (fromIntegral left)
 (fromIntegral top) (fromIntegral right) (fromIntegral bottom)

-- | set role (additional window name for the WM)
--
windowSetRole :: WindowClass w => w -> String -> IO ()
windowSetRole w str = 
  withUTFString str ({#call window_set_role#} (toWindow w))

-- | show the window on every workspace
--
windowStick :: WindowClass w => w -> IO ()
windowStick w = {#call window_stick#} (toWindow w)

-- | do not show the window on every workspace
--
windowUnstick :: WindowClass w => w -> IO ()
windowUnstick w = {#call window_unstick#} (toWindow w)

-- signals

-- | 
--
onFrameEvent, afterFrameEvent :: WindowClass w => w -> (Event -> IO Bool) ->
                                 IO (ConnectId w)
onFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent False
afterFrameEvent = connect_BOXED__BOOL "frame_event" marshalEvent True

-- | 
--
onSetFocus, afterSetFocus :: (WindowClass w, WidgetClass foc) => w ->
                             (foc -> IO ()) -> IO (ConnectId w)
onSetFocus = connect_OBJECT__NONE "set_focus" False
afterSetFocus = connect_OBJECT__NONE "set_focus" True




--- NEW FILE: FileSel.chs ---
--  -*-haskell-*-
--  GIMP Toolkit (GTK) Binding for Haskell: Widget FileSel
--
--  Author : Manuel M T Chakravarty
--  Created: 20 January 1999
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:37:33 $
--
--  Copyright (c) [1999..2002] Manuel M T Chakravarty
--  Copyright (c) 2002 Jens Petersen
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- The file selection widget is a quick and simple way to display a File
-- dialog box.  It comes complete with Ok & Cancel buttons; optionally, it
-- can have file operation buttons.
--
-- * As of gtk 2.4 this module has been deprecated in favour of "FileChooser"
--
-- TODO
--
-- * Fix fileSelectionQueryButtons
--
module Graphics.UI.Gtk.Windows.FileSel (
  FileSelectionClass,
  FileSelection,
  fileSelectionNew,
  fileSelectionSetFilename,
  fileSelectionGetFilename,
  fileSelectionShowFileopButtons,
  fileSelectionHideFileopButtons,
  fileSelectionGetButtons,
  fileSelectionComplete
  ) where

import Monad            (liftM)

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

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


-- operations
-- ----------

-- | Create a new file selection dialog with 
-- the given window title.
--
fileSelectionNew       :: String -> IO FileSelection
fileSelectionNew title  = do
  withUTFString title $ \strPtr -> 
    makeNewObject mkFileSelection $ liftM castPtr $ 
			{#call unsafe file_selection_new#} strPtr

-- | Set the filename for the given file 
-- selection dialog.
--
fileSelectionSetFilename :: FileSelectionClass fsel => fsel -> String -> IO ()
fileSelectionSetFilename fsel str = 
  withUTFString str $ \strPtr -> 
    {#call unsafe file_selection_set_filename#} (toFileSelection fsel) strPtr

-- | Get the filename currently selected by 
-- the given file selection dialog.
--
fileSelectionGetFilename :: FileSelectionClass fsel => fsel -> IO String
fileSelectionGetFilename fsel = 
  do
    strPtr <- {#call unsafe file_selection_get_filename#} 
      (toFileSelection fsel)
    peekUTFString strPtr

-- | Show the file operation buttons 
-- of the given file selection dialog.
--
fileSelectionShowFileopButtons :: FileSelectionClass fsel => fsel -> IO ()
fileSelectionShowFileopButtons  =
  {#call file_selection_show_fileop_buttons#} . toFileSelection

-- | Hide the file operation buttons 
-- of the given file selection dialog.
--
fileSelectionHideFileopButtons :: FileSelectionClass fsel => fsel -> IO ()
fileSelectionHideFileopButtons  =
  {#call file_selection_hide_fileop_buttons#} . toFileSelection

-- currently broken
-- -- query the widgets of the file selectors buttons
-- --
-- -- * this is useful to attach signals handlers to these buttons
-- --
-- -- * the buttons are OK & Cancel (in this order)
-- --
-- fileSelectionQueryButtons :: FileSelectionClass fsel 
-- 			  => fsel
-- 			  -> IO (Button, Button)
-- fileSelectionQueryButtons fsel =
--   withForeignPtr (unFileSelection $ toFileSelection fsel) $ \ ptr -> do
--       ok     <- {#get FileSelection.ok_button    #} ptr
--       cancel <- {#get FileSelection.cancel_button#} ptr
--       return (castToButton ok, castToButton cancel)

-- | Only show files matching pattern.
--
fileSelectionComplete :: FileSelectionClass fsel => fsel -> String -> IO ()
fileSelectionComplete fsel pattern =
  withUTFString pattern $ \patternPtr ->
    {#call file_selection_complete#} (toFileSelection fsel) patternPtr

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/TreeList CellRenderer.hs,NONE,1.1 CellRendererPixbuf.chs,NONE,1.1 CellRendererText.chs,NONE,1.1 CellRendererToggle.chs,NONE,1.1 TreeStore.chs.pp,NONE,1.1

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

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

Added Files:
	CellRenderer.hs CellRendererPixbuf.chs CellRendererText.chs 
	CellRendererToggle.chs TreeStore.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: CellRenderer.hs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) CellRenderer TreeView
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:36:43 $
--
--  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 'CellRenderer' is an object that determines how the cell of a
-- 'TreeView' widget is displayed. 
--
-- * Each 'TreeViewColumn' has exactly one accociated 'CellRenderer'.
--   The data supply for a cell is contained in a 'TreeStore' or a
--   'ListStore' (both subclasses of 'TreeModel'). Each 'CellRenderer'
--   may have several attributes. Each 'Attribute' is associated with 
--   one column of the 'TreeModel' database. Thus several columns of a 
--   'TreeModel' may be the supply for one 'TreeViewColumn'.
--

module Graphics.UI.Gtk.TreeList.CellRenderer (
  CellRenderer,
  CellRendererClass,
  Attribute(..),
  cellRendererSet,
  cellRendererGet
  ) where

import Graphics.UI.Gtk.Types
import System.Glib.StoreValue	(GenericValue, TMType)
import Graphics.UI.Gtk.Abstract.Object	(objectSetProperty, objectGetProperty)

-- | Definition of the 'Attribute' data type.
--
-- * Each 'CellRenderer' defines a set of attributes. They are used
--   by the Mogul layer to generate columns in a 'TreeStore' or
--   'ListStore'.
--
data CellRendererClass cr => Attribute cr a = Attribute [String] [TMType]
					      (a -> IO [GenericValue]) 
					      ([GenericValue] -> IO a)

-- | Set a property statically.
--
-- * Instead of using a 'TreeStore' or 'ListStore' to set
--   properties of a 'CellRenderer' this method allows to set such
--   a property for the whole column.
--
cellRendererSet :: CellRendererClass cr => 
		   cr -> Attribute cr val -> val -> IO ()
cellRendererSet cr (Attribute names _ write _) val = do
  values <- write val
  mapM_ (uncurry $ objectSetProperty cr) (zip names values)

-- | Get a static property.
--
-- * See 'cellRendererSet'. Note that calling this function on a
--   property of a 'CellRenderer' object which retrieves its values
--   from a 'ListStore' or 'TreeStore' will result in an
--   abitrary value.
--
cellRendererGet :: CellRendererClass cr =>
		   cr -> Attribute cr val -> IO val
cellRendererGet cr (Attribute names _ _ read) = do
  values <- mapM (objectGetProperty cr) names
  read values

--- NEW FILE: TreeStore.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TreeStore TreeModel
--
--  Author : Axel Simon
--          
--  Created: 9 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:36:43 $
--
--  Copyright (c) 2001 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.
--
-- |
--

module Graphics.UI.Gtk.TreeList.TreeStore (
  TreeStore,
  TMType(..),
  GenericValue(..),
  treeStoreNew,
  treeStoreSetValue,
  treeStoreRemove,
  treeStoreInsert,
  treeStoreInsertBefore,
  treeStoreInsertAfter,
  treeStorePrepend,
  treeStoreAppend,
  treeStoreIsAncestor,
  treeStoreIterDepth,
  treeStoreClear
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)

import System.Glib.FFI
import System.Glib.GObject			(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
import Graphics.UI.Gtk.General.Structs		(treeIterSize)
import System.Glib.StoreValue			(TMType(..), GenericValue(..))
{#import System.Glib.GValue#}			(GValue, valueUnset)
import System.Glib.GType			(GType)

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

-- methods

-- | Generate a new entity to store tree information.
--
treeStoreNew :: [TMType] -> IO TreeStore
treeStoreNew cols = makeNewGObject mkTreeStore $ 
  withArray0 ((fromIntegral.fromEnum) TMinvalid) 
  (map (fromIntegral.fromEnum) cols) $
  {#call unsafe tree_store_newv#} ((fromIntegral.length) cols)

-- | Set the data of a specific node. The supplied
-- value must match the type that was set for the column.
--
treeStoreSetValue :: (TreeStoreClass ts) => ts -> TreeIter -> Int ->
                     GenericValue -> IO ()
treeStoreSetValue ts ti col val = with val $ \vPtr -> do
  {#call unsafe tree_store_set_value#} (toTreeStore ts) ti 
    (fromIntegral col) vPtr
  valueUnset vPtr

#if GTK_CHECK_VERSION(2,2,0)
-- | Remove a specific node.
--
-- * The 'TreeIter' will point to the entry following the one which
--   was just removed. The function returns @False@ if the
--   @ti@TreeIter does not point to a valid element (i.e. the
--   function just removed the bottom entry from the tree).
--
-- * This function returned @()@ in Gtk version 2.0.X
--
treeStoreRemove :: (TreeStoreClass ts) => ts -> TreeIter -> IO Bool
treeStoreRemove ts ti = liftM toBool $ 
  {#call tree_store_remove#} (toTreeStore ts) ti

#else
-- | Remove a specific node.
--
-- * The 'TreeIter' will point to the entry following the one which
--   was just removed.
--
-- * This function returns @Bool@ in Gtk version
--   2.2.0 and later
--
treeStoreRemove :: (TreeStoreClass ts) => ts -> TreeIter -> IO ()
treeStoreRemove ts ti = {#call tree_store_remove#} (toTreeStore ts) ti
#endif


-- | Insert a child node into the tree. If the parent
-- is Nothing the insert at the root of the tree. The pos parameter determines
-- the position with respect to other siblings. Set this to -1 to insert the
-- node as last node.
--
treeStoreInsert :: (TreeStoreClass ts) => ts -> Maybe TreeIter -> Int ->
                   IO TreeIter
treeStoreInsert ts parent pos = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call tree_store_insert#} (toTreeStore ts) iter 
    (fromMaybe (TreeIter nullForeignPtr) parent) (fromIntegral pos)
  return iter


-- | Insert a node in front of the
-- @sibling@ node on the same level.
--
treeStoreInsertBefore :: (TreeStoreClass ts) => ts -> TreeIter -> IO TreeIter
treeStoreInsertBefore ts sibling = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call tree_store_insert_before#} (toTreeStore ts) iter (TreeIter nullForeignPtr) sibling
  return iter

-- | Insert a node behind the @sibling@
-- node on the same level.
--
treeStoreInsertAfter :: (TreeStoreClass ts) => ts -> TreeIter -> IO TreeIter
treeStoreInsertAfter ts sibling = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call tree_store_insert_after#} (toTreeStore ts) iter (TreeIter nullForeignPtr) sibling
  return iter

-- | Insert a child node in front of every other
-- sibling.
--
-- * This is equivalent to 'treeStoreInsert' @parent 0@ .
--
treeStorePrepend :: (TreeStoreClass ts) => ts -> Maybe TreeIter -> IO TreeIter
treeStorePrepend ts parent = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call tree_store_prepend#} (toTreeStore ts) iter 
    (fromMaybe (TreeIter nullForeignPtr) parent)
  return iter

-- | Insert a child node behind other siblings.
--
-- * This is equivalent to 'treeStoreInsert' @parent (-1)@ .
--
treeStoreAppend :: (TreeStoreClass ts) => ts -> Maybe TreeIter -> IO TreeIter
treeStoreAppend ts parent = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call tree_store_append#} (toTreeStore ts) iter 
    (fromMaybe (TreeIter nullForeignPtr) parent)
  return iter

-- | Check if a node is in a parental relationship
-- with another node. Returns True even if parent is grandparent,... of child.
--
treeStoreIsAncestor :: (TreeStoreClass ts) => ts -> TreeIter -> TreeIter ->
                       IO Bool
treeStoreIsAncestor ts parent child = liftM toBool $
  {#call unsafe tree_store_is_ancestor#} (toTreeStore ts) parent child

-- | Calculate the level of a node. Returns 1 for a
-- root node.
--
treeStoreIterDepth :: (TreeStoreClass ts) => ts -> TreeIter -> IO Int
treeStoreIterDepth ts iter = liftM fromIntegral $
  {#call unsafe tree_store_iter_depth#} (toTreeStore ts) iter

-- | Removes all rows from the store.
--
treeStoreClear :: (TreeStoreClass ts) => ts -> IO ()
treeStoreClear ts =
  {#call tree_store_clear#} (toTreeStore ts)
  

--- NEW FILE: CellRendererText.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) CellRendererText TreeView
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:36:43 $
--
--  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 'CellRenderer' which displays a single-line text.
--
-- * This widget derives from 'CellRenderer'. It provides the 
--   possibility to display some text by setting the 'Attribute' 
--   'cellText' to the column of a 'TreeModel' by means of 
--   'treeViewAddAttribute' from 'TreeModelColumn'.
--

module Graphics.UI.Gtk.TreeList.CellRendererText (
  CellRendererText,
  CellRendererTextClass,
  castToCellRendererText,
  cellRendererTextNew,
  cellText,
  cellMarkup,
  cellBackground,
  cellForeground,
  cellEditable,
  onEdited,
  afterEdited
  ) where

import Maybe	(fromMaybe)
import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object		(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
import Graphics.UI.Gtk.General.Structs		(treeIterSize)
import Graphics.UI.Gtk.TreeList.CellRenderer	(Attribute(..))
import System.Glib.StoreValue			(GenericValue(..), TMType(..))

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

-- methods

-- | Create a new CellRendererText object.
--
cellRendererTextNew :: IO CellRendererText
cellRendererTextNew  = makeNewObject mkCellRendererText $ liftM castPtr $
  {#call unsafe cell_renderer_text_new#}

-- helper function
--
strAttr :: [String] -> Attribute CellRendererText String
strAttr str = Attribute str [TMstring]
	        (return . (\x -> [x]) . GVstring . Just)
		(\[GVstring str] -> return (fromMaybe "" str))

mStrAttr :: [String] -> Attribute CellRendererText (Maybe String)
mStrAttr str = Attribute str [TMstring]
	        (return . (\x -> [x]) . GVstring)
		(\[GVstring str] -> return str)

-- | Define the attribute that specifies the text to be
-- rendered.
--
cellText :: Attribute CellRendererText String
cellText  = strAttr ["text"]

-- | Define a markup string instead of a text.
--
cellMarkup :: Attribute CellRendererText String
cellMarkup  = strAttr ["markup"]

-- | A named color for the background paint.
--
cellBackground :: Attribute CellRendererText (Maybe String)
cellBackground  = mStrAttr ["background"]

-- | A named color for the foreground paint.
--
cellForeground :: Attribute CellRendererText (Maybe String)
cellForeground  = mStrAttr ["foreground"]

-- | Determines wether the content can be altered.
--
-- * If this flag is set, the user can alter the cell.
--
cellEditable :: Attribute CellRendererText (Maybe Bool)
cellEditable = Attribute ["editable","editable-set"] [TMboolean,TMboolean]
	         (\mb -> return $ case mb of
		   (Just bool) -> [GVboolean bool, GVboolean True]
		   Nothing     -> [GVboolean True, GVboolean True])
		 (\[GVboolean e, GVboolean s] -> return $
		   if s then Just e else Nothing)

-- | Emitted when the user finished editing a cell.
--
-- * This signal is not emitted when editing is disabled (see 
--   'cellEditable') or when the user aborts editing.
--
onEdited, afterEdited :: TreeModelClass tm => CellRendererText -> tm ->
			 (TreeIter -> String -> IO ()) ->
			 IO (ConnectId CellRendererText)
onEdited cr tm user = connect_PTR_STRING__NONE "edited" False cr $
  \strPtr string -> do
    iterPtr <- mallocBytes treeIterSize
    iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
    res <- liftM toBool $ withForeignPtr ((unTreeModel . toTreeModel) tm) $
      \tmPtr -> withForeignPtr (unTreeIter iter) $ \iterPtr ->
	gtk_tree_model_get_iter_from_string tmPtr iterPtr strPtr
    if res then user iter string else
      putStrLn "edited signal: invalid tree path"

afterEdited cr tm user = connect_PTR_STRING__NONE "edited" True cr $
  \strPtr string -> do
    iterPtr <- mallocBytes treeIterSize
    iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
    res <- liftM toBool $ withForeignPtr ((unTreeModel . toTreeModel) tm) $
      \tmPtr -> withForeignPtr (unTreeIter iter) $ \iterPtr ->
	gtk_tree_model_get_iter_from_string tmPtr iterPtr strPtr
    if res then user iter string else
      putStrLn "edited signal: invalid tree path"

unTreeIter (TreeIter iter) = iter

--- NEW FILE: CellRendererToggle.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) CellRendererToggle
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:36:43 $
--
--  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.
--
-- |
--
module Graphics.UI.Gtk.TreeList.CellRendererToggle (
  CellRendererToggle,
  CellRendererToggleClass,
  castToCellRendererToggle,
  cellRendererToggleNew,
  cellRendererToggleGetRadio,
  cellRendererToggleSetRadio,
  cellRendererToggleGetActive,
  cellRendererToggleSetActive,
  cellActive,
  cellRadio
  ) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.TreeList.CellRenderer (Attribute(..))
import System.Glib.StoreValue   (GenericValue(..), TMType(..))

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

-- methods

-- | Create a new 'CellRenderer' that displays a 'ToggleButton'.
--
cellRendererToggleNew :: IO CellRendererToggle
cellRendererToggleNew  = makeNewObject mkCellRendererToggle $
  liftM castPtr $ {#call unsafe cell_renderer_toggle_new#}

-- | Determine whether the button is drawn as 'RadioButton' or not.
--
cellRendererToggleSetRadio :: CellRendererToggleClass crt => crt -> Bool ->
                              IO ()
cellRendererToggleSetRadio crt radio = {#call cell_renderer_toggle_set_radio#}
  (toCellRendererToggle crt) (fromBool radio)

-- | Returns wether the button is drawn as 'RadioButton' or not.
--
cellRendererToggleGetRadio :: CellRendererToggleClass crt => crt -> IO Bool
cellRendererToggleGetRadio crt = liftM toBool $
  {#call cell_renderer_toggle_get_radio#} (toCellRendererToggle crt)

-- | Retrieve the current state of the button.
--
cellRendererToggleGetActive :: CellRendererToggleClass crt => crt -> IO Bool
cellRendererToggleGetActive crt = liftM toBool $
  {#call unsafe cell_renderer_toggle_get_active#} (toCellRendererToggle crt)


-- | Modify the state of the button.
--
cellRendererToggleSetActive :: CellRendererToggleClass crt => crt -> Bool ->
                               IO ()
cellRendererToggleSetActive crt act = {#call cell_renderer_toggle_set_active#}
  (toCellRendererToggle crt) (fromBool act)

-- helper function
--
binAttr :: [String] -> Attribute CellRendererToggle Bool
binAttr str = Attribute str [TMboolean]
		(return.(\x -> [x]).GVboolean)
	        (\[GVboolean b] -> return b)

-- | Define the attribute that reflects the state of the button.
--
cellActive :: Attribute CellRendererToggle Bool
cellActive  = binAttr ["active"]

-- | Define an attribute that determines whether this button
-- is shown as a 'RadioButton' or as a normal 'ToggleButton'.
--
cellRadio :: Attribute CellRendererToggle Bool
cellRadio  = binAttr ["radio"]

--- NEW FILE: CellRendererPixbuf.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) CellRendererPixbuf
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:36:43 $
--
--  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.
--
-- |
--

module Graphics.UI.Gtk.TreeList.CellRendererPixbuf (
  CellRendererPixbuf,
  CellRendererPixbufClass,
  castToCellRendererPixbuf,
  cellRendererPixbufNew,
--  cellPixbuf
  ) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object		(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.TreeList.CellRenderer	(Attribute(..))
import Graphics.UI.Gtk.Display.Image		(imageNewFromPixbuf,
						 imageGetPixbuf)
import System.Glib.StoreValue   (GenericValue(..), TMType(..))

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

-- methods

-- | Create a new CellRendererPixbuf object.
--
cellRendererPixbufNew :: IO CellRendererPixbuf
cellRendererPixbufNew  = makeNewObject mkCellRendererPixbuf $ liftM castPtr $
  {#call unsafe cell_renderer_pixbuf_new#}

-- | Define the attribute that specifies the
-- 'Pixbuf' to be rendered.
--
--cellPixbuf :: Attribute CellRendererPixbuf Image
--cellPixbuf  = Attribute ["pixbuf"] [TMobject]
--  (liftM ((\x -> [x]) . GVobject . toGObject) . imageGetPixbuf)
--  (\[GVobject obj] -> imageNewFromPixbuf (fromGObject obj))

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/TreeList TreeModel.chs.pp,NONE,1.1 ListStore.chs.pp,NONE,1.1

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

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

Added Files:
	TreeModel.chs.pp ListStore.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: ListStore.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) ListStore TreeModel
--
--  Author : Axel Simon
--          
--  Created: 9 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:35:19 $
--
--  Copyright (c) 2001 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 database for simple (non-hierarchical) tables.
--
module Graphics.UI.Gtk.TreeList.ListStore (
  ListStore,
  TMType(..),
  GenericValue(..),
  listStoreNew,
  listStoreSetValue,
  listStoreRemove,
  listStoreInsert,
  listStoreInsertBefore,
  listStoreInsertAfter,
  listStorePrepend,
  listStoreAppend,
  listStoreClear
#if GTK_CHECK_VERSION(2,2,0)
 ,listStoreReorder,
  listStoreSwap,
  listStoreMoveBefore,
  listStoreMoveAfter
#endif
  ) where

import Monad	(liftM, when)
import Maybe	(fromMaybe)

import System.Glib.FFI
import System.Glib.GObject			(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
import Graphics.UI.Gtk.General.Structs		(treeIterSize)
import System.Glib.StoreValue			(TMType(..), GenericValue(..))
{#import System.Glib.GValue#}			(GValue, valueUnset)
import System.Glib.GType			(GType)

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

-- methods

-- | Generate a new entity to store tree information.
--
listStoreNew :: [TMType] -> IO ListStore
listStoreNew cols = makeNewGObject mkListStore $ 
  withArray0 ((fromIntegral.fromEnum) TMinvalid) 
  (map (fromIntegral.fromEnum) cols) $
  {#call unsafe list_store_newv#} ((fromIntegral.length) cols)

-- | Set the data of a specific node.
--
-- * The supplied value must match the type that was set for the column.
--
listStoreSetValue :: (ListStoreClass ts) => ts -> TreeIter -> Int ->
                     GenericValue -> IO ()
listStoreSetValue ts ti col val = with val $ \vPtr -> do
  {#call unsafe list_store_set_value#} (toListStore ts) ti 
    (fromIntegral col) vPtr
  valueUnset vPtr

#if GTK_CHECK_VERSION(2,2,0)
-- | Remove a specific node.
--
-- * The 'TreeIter' will point to the entry following the one which
--   was just removed. The function returns @False@ if the
--   @ti@TreeIter does not point to a valid element (i.e. the
--   function just removed the bottom entry from the list).
--
-- * This function returned @()@ in Gtk version 2.0.X
--
listStoreRemove :: (ListStoreClass ts) => ts -> TreeIter -> IO Bool
listStoreRemove ts ti = liftM toBool $ 
  {#call list_store_remove#} (toListStore ts) ti

#else
-- | Remove a specific node.
--
-- * The 'TreeIter' will point to the entry following the one which
--   was just removed.
--
-- * This function returns @Bool@ in Gtk version 2.2.0 and later
--
listStoreRemove :: (ListStoreClass ts) => ts -> TreeIter -> IO ()
listStoreRemove ts ti = {#call list_store_remove#} (toListStore ts) ti
#endif

-- | Insert a new row into the list.
--
-- * The @pos@ parameter
-- determines the row number where the row should be inserted. Set this to
-- @-1@ to insert at the end of the list.
--
listStoreInsert :: (ListStoreClass ts) => ts -> Int -> IO TreeIter
listStoreInsert ts pos = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call list_store_insert#} (toListStore ts) iter (fromIntegral pos)
  return iter


-- | Insert a row in front of the
-- @sibling@ node.
--
listStoreInsertBefore :: (ListStoreClass ts) => ts -> TreeIter -> IO TreeIter
listStoreInsertBefore ts sibling = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call list_store_insert_before#} (toListStore ts) iter sibling
  return iter

-- | Insert a row behind the @sibling@
-- row.
--
listStoreInsertAfter :: (ListStoreClass ts) => ts -> TreeIter -> IO TreeIter
listStoreInsertAfter ts sibling = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call list_store_insert_after#} (toListStore ts) iter sibling
  return iter

-- | Insert a row in front of every other row.
--
-- * This is equivalent to 'listStoreInsert' @0@.
--
listStorePrepend :: (ListStoreClass ts) => ts -> IO TreeIter
listStorePrepend ts = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call list_store_prepend#} (toListStore ts) iter 
  return iter

-- | Insert a row at the end of the table .
--
-- * This is equivalent to 'listStoreInsert' (-1).
--
listStoreAppend :: (ListStoreClass ts) => ts -> IO TreeIter
listStoreAppend ts = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  {#call list_store_append#} (toListStore ts) iter 
  return iter

-- | Clear all rows in this table.
--
listStoreClear :: (ListStoreClass ts) => ts -> IO ()
listStoreClear = {#call list_store_clear#}.toListStore

#if GTK_CHECK_VERSION(2,2,0)
-- | Reorders store to follow the order indicated by the mapping. The list
-- argument should be a mapping from the /new/ positions to the /old/
-- positions. That is @newOrder !! newPos = oldPos@
--
-- * Note that this function only works with unsorted stores.
--
-- * You must make sure the mapping is the right size for the store, use
-- @'treeModelIterNChildren' store Nothing@ to check.
--
listStoreReorder :: (ListStoreClass ts) => ts -> [Int] -> IO ()
listStoreReorder ts newOrder = do
  --check newOrder is the right length or it'll overrun
  storeLength <- treeModelIterNChildren ts Nothing
  when (storeLength /= length newOrder)
       (fail "ListStore.listStoreReorder: mapping wrong length for store")
  withArray (map fromIntegral newOrder) $ \newOrderArrPtr ->
    {#call list_store_reorder#} (toListStore ts) newOrderArrPtr

-- | Swaps the two items in the store.
--
-- * Note that this function only works with unsorted stores.
--
listStoreSwap :: (ListStoreClass ts) => ts -> TreeIter -> TreeIter -> IO ()
listStoreSwap ts a b =
  {#call list_store_swap#} (toListStore ts) a b

-- | Moves the item in the store to before the given position. If the position
-- is @Nothing@ the item will be moved to then end of the list.
--
-- * Note that this function only works with unsorted stores.
--
listStoreMoveBefore :: (ListStoreClass ts) => ts
                    -> TreeIter       -- ^ Iter for the item to be moved
		    -> Maybe TreeIter -- ^ Iter for the position or @Nothing@.
		    -> IO ()
listStoreMoveBefore ts iter maybePosition =
   {#call list_store_move_before#} (toListStore ts) iter
     (fromMaybe (TreeIter nullForeignPtr) maybePosition)

-- | Moves the item in the store to after the given position. If the position
-- is @Nothing@ the item will be moved to then start of the list.
--
-- * Note that this function only works with unsorted stores.
--
listStoreMoveAfter :: (ListStoreClass ts) => ts
                   -> TreeIter       -- ^ Iter for the item to be moved
		   -> Maybe TreeIter -- ^ Iter for the position or @Nothing@.
		   -> IO ()
listStoreMoveAfter ts iter maybePosition =
  {#call list_store_move_after#} (toListStore ts) iter
    (fromMaybe (TreeIter nullForeignPtr) maybePosition)
#endif

--- NEW FILE: TreeModel.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TreeModel
--
--  Author : Axel Simon
--          
--  Created: 8 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:35:19 $
--
--  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 'TreeModel' is the abstract base class for 
-- 'TreeStore' and 'ListStore'.
--
-- * Most functions are defined in the latter two classes. This module
--   provides the 'TreeIter' and 'TreePath' objects.
--
module Graphics.UI.Gtk.TreeList.TreeModel (
  TreeModel,
  TreeModelClass,
  castToTreeModel,
  treeModelGetNColumns,
  treeModelGetColumnType,
  treeModelGetValue,
  TreeModelFlags(..),
  treeModelGetFlags,
  TreePath(..),
  createTreePath,			-- internal
  tree_path_copy,			-- internal
  tree_path_free,			-- internal
  treePathNew,
  treePathNewFromString,
  treePathNewFromIndicies,
  treePathToString,
  treePathNewFirst,
  treePathAppendIndex,
  treePathPrependIndex,
  treePathGetDepth,
  treePathGetIndices,
  treePathCopy,
  treePathCompare,
  treePathNext,
  treePathPrev,
  treePathUp,
  treePathDown,
  treePathIsAncestor,
  treePathIsDescendant,
  TreeRowReference(..),
  treeRowReferenceNew,
  treeRowReferenceGetPath,
  treeRowReferenceValid,
  TreeIter(..),
  createTreeIter,			-- internal
  treeModelGetIter,
  treeModelGetIterFromString,
  gtk_tree_model_get_iter_from_string,	-- internal
  treeModelGetIterFirst,
  treeModelGetPath,
  treeModelIterNext,
  treeModelIterChildren,
  treeModelIterHasChild,
  treeModelIterNChildren,
  treeModelIterNthChild,
  treeModelIterParent,
  treeModelRefNode,
  treeModelUnrefNode
  ) where

import Monad	(liftM, when)
import Maybe	(fromMaybe)
import List   (intersperse)

import System.Glib.FFI
import System.Glib.UTFString
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(treeIterSize)
import Graphics.UI.Gtk.Gdk.Enums	(Flags(..))
import System.Glib.StoreValue		(TMType)
{#import System.Glib.GValue#}		(GValue, GenericValue, valueUnset)

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

-- | Tree Iterator : A pointer to an entry in a 'TreeStore' or 'ListStore'.
--
{#pointer * TreeIter foreign newtype#}

-- | TreePath : a list of indices to specify a subtree or node in the
-- hierarchical 'TreeStore' database.
--
{#pointer * TreePath foreign newtype#}

-- | Tree Row Reference : like a 'TreePath' it points to a subtree or node, but
-- it is persistent. It identifies the same node (so long as it exists) even
-- when items are added, removed, or reordered.
--
{#pointer * TreeRowReference foreign newtype#}

-- | These flags indicate various properties of a 'TreeModel'. These are
-- probably not terribly interesting for app developers. See the C documentation
-- for details.
--
{#enum TreeModelFlags {underscoreToCase} deriving(Bounded)#}

instance Flags TreeModelFlags

-- methods

-- | Read the number of columns this 'TreeModel' currently stores.
--
treeModelGetNColumns :: TreeModelClass tm => tm -> IO Int
treeModelGetNColumns tm = liftM fromIntegral $ 
  {#call unsafe tree_model_get_n_columns#} (toTreeModel tm)

-- | Retrieves the type of a specific column.
--
treeModelGetColumnType :: TreeModelClass tm => tm -> Int -> IO TMType
treeModelGetColumnType tm col = liftM (toEnum.fromIntegral) $
  {#call unsafe tree_model_get_column_type#} (toTreeModel tm) 
  (fromIntegral col)

-- | Read the value of at a specific column and 'Iterator'.
--
treeModelGetValue :: TreeModelClass tm => tm -> TreeIter -> Int ->
                     IO GenericValue
treeModelGetValue tm iter col = alloca $ \vaPtr -> do
  -- don't know if this is necessary, see treeList/StoreValue.hsc
  poke (castPtr vaPtr) (0:: {#type GType#})
  {#call unsafe tree_model_get_value#} (toTreeModel tm) iter 
    (fromIntegral col) vaPtr
  val <- peek vaPtr
  valueUnset vaPtr
  return val

-- | Maps a function over each node in model in a depth-first fashion. If the
-- function returns True, the tree walk stops.
--
treeModelForeach :: TreeModelClass tm => tm -> (TreeIter -> IO Bool) -> IO ()
treeModelForeach tm fun = do
  fPtr <- mkTreeModelForeachFunc (\_ _ ti _ -> do
    -- make a deep copy of the iterator. This makes it possible to store this
    -- iterator in Haskell land somewhere. The TreeModel parameter is not
    -- passed to the function due to performance reasons. But since it is
    -- a constant this does not matter.
    iterPtr <- mallocBytes treeIterSize
    copyBytes iterPtr ti treeIterSize
    iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
    liftM (fromIntegral.fromBool) $ fun iter
    )
  {#call tree_model_foreach#} (toTreeModel tm) fPtr nullPtr
  freeHaskellFunPtr fPtr

{#pointer TreeModelForeachFunc#}

foreign import ccall "wrapper"  mkTreeModelForeachFunc ::
  (Ptr () -> Ptr () -> Ptr TreeIter -> Ptr () -> IO CInt) -> IO TreeModelForeachFunc

-- | Returns a set of flags supported by this interface. The flags supported
-- should not change during the lifecycle of the model.
--
treeModelGetFlags :: TreeModelClass tm => tm -> IO [TreeModelFlags]
treeModelGetFlags tm = liftM (toFlags.fromIntegral) $
  {#call unsafe tree_model_get_flags#} (toTreeModel tm)

-- utilities related to tree models

-- Create a TreePath from a pointer.
createTreePath :: Ptr TreePath -> IO TreePath
createTreePath tpPtr = do
  tpPtr' <- tree_path_copy tpPtr
  liftM TreePath $ newForeignPtr tpPtr' (tree_path_free tpPtr')

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_tree_path_free"
  tree_path_free' :: FinalizerPtr TreePath

tree_path_free :: Ptr TreePath -> FinalizerPtr TreePath
tree_path_free _ = tree_path_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_tree_path_free"
  tree_path_free :: Ptr TreePath -> IO ()

#else

foreign import ccall "gtk_tree_path_free" unsafe
  tree_path_free :: Ptr TreePath -> IO ()

#endif



-- | Create a new 'TreePath'.
--
-- * A 'TreePath' is an hierarchical index. It is independent of a specific
-- 'TreeModel'.
-- 
treePathNew :: IO TreePath
treePathNew = do
  tpPtr <- {#call unsafe tree_path_new#} 
  liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr)

-- | Turn a @String@ into a 'TreePath'.
--
-- * For example, the string \"10:4:0\" would create a path of depth 3 pointing
-- to the 11th child of the root node, the 5th child of that 11th child, and the
-- 1st child of that 5th child.
--
treePathNewFromString :: String -> IO TreePath
treePathNewFromString path = do
  tpPtr <- throwIfNull "treePathNewFromString: invalid path given" $
    withUTFString path {#call unsafe tree_path_new_from_string#}
  liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr)

-- | Turn a list of indicies into a 'TreePath'. See 'treePathNewFromString' for
-- the meaning of these indicies.
--
treePathNewFromIndicies :: [Int] ->  IO TreePath
treePathNewFromIndicies =
  treePathNewFromString . concat . intersperse ":" . map show

-- | Turn a 'TreePath' into a @String@.
--
treePathToString :: TreePath -> IO String
treePathToString tp = do
  strPtr <- {#call tree_path_to_string#} tp
  str <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str

-- | Create a 'TreePath'.
--
-- * The returned 'TreePath' is an index to the first element.
--
treePathNewFirst :: IO TreePath
treePathNewFirst = do
  tpPtr <- {#call unsafe tree_path_new_first#}
  liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr)

-- | Add an index on the next level.
treePathAppendIndex :: TreePath -> Int -> IO ()
treePathAppendIndex tp ind = 
  {#call unsafe tree_path_append_index#} tp (fromIntegral ind)


treePathPrependIndex :: TreePath -> Int -> IO ()
treePathPrependIndex tp ind =
  {#call unsafe tree_path_prepend_index#} tp (fromIntegral ind)

treePathGetDepth :: TreePath -> IO Int
treePathGetDepth tp = liftM fromIntegral $ 
  {#call unsafe tree_path_get_depth#} tp

treePathGetIndices :: TreePath -> IO [Int]
treePathGetIndices tp = do
  depth <- treePathGetDepth tp
  arrayPtr <- {#call unsafe tree_path_get_indices#} tp
  if (depth==0 || arrayPtr==nullPtr) then return [] else
    sequence [liftM fromIntegral $ peekElemOff arrayPtr e 
	     | e <- [0..depth-1]]

treePathCopy :: TreePath -> IO TreePath
treePathCopy tp = do
  tpPtr' <- {#call unsafe tree_path_copy#} tp
  liftM TreePath $ newForeignPtr tpPtr' (tree_path_free tpPtr')

#if __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_tree_path_copy"
  tree_path_copy :: Ptr TreePath -> IO (Ptr TreePath)

#else

foreign import ccall "gtk_tree_path_copy" unsafe
  tree_path_copy :: Ptr TreePath -> IO (Ptr TreePath)

#endif


treePathCompare :: TreePath -> TreePath -> IO Ordering
treePathCompare tp1 tp2 = do
  res <- {#call unsafe tree_path_compare#} tp1 tp2
  return $ case res of
    (-1)   -> LT
    0	   -> EQ
    1	   -> GT

treePathNext :: TreePath -> IO ()
treePathNext = {#call unsafe tree_path_next#}

treePathPrev :: TreePath -> IO Bool
treePathPrev tp = liftM toBool $ {#call unsafe tree_path_prev#} tp

treePathUp :: TreePath -> IO Bool
treePathUp tp = liftM toBool $ {#call unsafe tree_path_up#} tp

treePathDown :: TreePath -> IO ()
treePathDown = {#call unsafe tree_path_down#}

-- | Returns True if the second path is a descendant of the first.
--
treePathIsAncestor :: TreePath -- ^ A 'TreePath'
                   -> TreePath -- ^ A possible descendant
                   -> IO Bool
treePathIsAncestor path descendant = liftM toBool $
  {#call unsafe tree_path_is_ancestor#} path descendant

-- | Returns True if the first path is a descendant of the second.
--
treePathIsDescendant :: TreePath -- ^ A possible descendant
                     -> TreePath -- ^ A 'TreePath' 
                     -> IO Bool
treePathIsDescendant path ancestor = liftM toBool $
  {#call unsafe tree_path_is_descendant#} path ancestor

-- | Creates a row reference based on a path. This reference will keep pointing
-- to the node pointed to by the given path, so long as it exists.
--
treeRowReferenceNew :: TreeModelClass tm => tm -> TreePath -> IO TreeRowReference
treeRowReferenceNew tm path = do
  rowRefPtr <- throwIfNull "treeRowReferenceNew: invalid path given" $
    {#call unsafe gtk_tree_row_reference_new#} (toTreeModel tm) path
  liftM TreeRowReference $
    newForeignPtr rowRefPtr (tree_row_reference_free rowRefPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_tree_row_reference_free"
  tree_row_reference_free' :: FinalizerPtr TreeRowReference

tree_row_reference_free :: Ptr TreeRowReference -> FinalizerPtr TreeRowReference
tree_row_reference_free _ = tree_row_reference_free'

#else

foreign import ccall unsafe "gtk_tree_row_reference_free"
  tree_row_reference_free :: Ptr TreeRowReference -> IO ()

#endif

-- | Returns a path that the row reference currently points to, or @Nothing@ if
-- the path pointed to is no longer valid.
--
treeRowReferenceGetPath :: TreeRowReference -> IO (Maybe TreePath)
treeRowReferenceGetPath ref = do
  pathPtr <- {#call unsafe tree_row_reference_get_path#} ref
  if pathPtr == nullPtr then return Nothing else
    liftM (Just . TreePath) $ newForeignPtr pathPtr (tree_path_free pathPtr)

-- | Returns True if the reference refers to a current valid path.
--
treeRowReferenceValid :: TreeRowReference -> IO Bool
treeRowReferenceValid ref = liftM toBool $
  {#call unsafe tree_row_reference_valid#} ref

createTreeIter :: Ptr TreeIter -> IO TreeIter
createTreeIter tiPtr = do
  tiPtr' <- tree_iter_copy tiPtr
  liftM TreeIter $ newForeignPtr tiPtr' (tree_iter_free tiPtr')


#if __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_tree_iter_copy"
  tree_iter_copy :: Ptr TreeIter -> IO (Ptr TreeIter)

#else

foreign import ccall "gtk_tree_iter_copy" unsafe
  tree_iter_copy :: Ptr TreeIter -> IO (Ptr TreeIter)

#endif

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_tree_iter_free"
  tree_iter_free' :: FinalizerPtr TreeIter

tree_iter_free :: Ptr TreeIter -> FinalizerPtr TreeIter
tree_iter_free _ = tree_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_tree_iter_free"
  tree_iter_free :: Ptr TreeIter -> IO ()

#else

foreign import ccall "gtk_tree_iter_free" unsafe
  tree_iter_free :: Ptr TreeIter -> IO ()

#endif


-- | Turn a 'TreePath' into a
-- 'TreeIter'.
--
-- * Returns @Nothing@ if the @tp@ is invalid.
--
treeModelGetIter :: TreeModelClass tm => tm -> TreePath -> IO (Maybe TreeIter)
treeModelGetIter tm tp = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  res <- {#call unsafe tree_model_get_iter#} (toTreeModel tm) iter tp
  return $ if (toBool res) then Just iter else Nothing
  
-- | Turn a @String@ into a
-- 'TreeIter'.
--
-- * Returns @Nothing@ if the table is empty.
--
treeModelGetIterFromString :: TreeModelClass tm => tm -> String -> 
						   IO (Maybe TreeIter)
treeModelGetIterFromString tm str = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  res <- withUTFString str $ \strPtr ->
    {#call unsafe tree_model_get_iter_from_string#} (toTreeModel tm) iter 
      strPtr
  return $ if (toBool res) then Just iter else Nothing

-- | Retrieves an 'TreeIter' to the
-- first entry.
--
-- * Returns @Nothing@ if the table is empty.
--
treeModelGetIterFirst :: TreeModelClass tm => tm -> IO (Maybe TreeIter)
treeModelGetIterFirst tm = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  res <- {#call unsafe tree_model_get_iter_first#} (toTreeModel tm) iter
  return $ if (toBool res) then Just iter else Nothing

treeModelGetPath :: TreeModelClass tm => tm -> TreeIter -> IO TreePath
treeModelGetPath tm iter =  do
  tpPtr <- throwIfNull "treeModelGetPath: illegal iterator" $
    {#call unsafe tree_model_get_path#} (toTreeModel tm) iter
  liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr)

-- | Advance the iterator to the next element.
--
-- * If there is no other element on this hierarchy level, return 
--   @False@.
--
treeModelIterNext :: TreeModelClass tm => tm -> TreeIter -> IO Bool
treeModelIterNext tm iter = liftM toBool $
 {#call unsafe tree_model_iter_next#} (toTreeModel tm) iter

-- | Retrieve an iterator to the first child.
--
treeModelIterChildren :: TreeModelClass tm => tm -> TreeIter -> 
					      IO (Maybe TreeIter)
treeModelIterChildren tm parent = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  res <- {#call unsafe tree_model_iter_children#} (toTreeModel tm) iter 
    parent
  return $ if (toBool res) then Just iter else Nothing

-- | Test if this is the last hierarchy level.
treeModelIterHasChild :: TreeModelClass tm => tm -> TreeIter -> IO Bool
treeModelIterHasChild tm iter = liftM toBool $
  {#call unsafe tree_model_iter_has_child#} (toTreeModel tm) iter

-- | Return the number of children.
--
-- * If @Nothing@ is specified for the @tm@ argument, the
--   function will work on toplevel elements.
--
treeModelIterNChildren :: TreeModelClass tm => tm -> Maybe TreeIter -> IO Int
treeModelIterNChildren tm iter = liftM fromIntegral $
  {#call unsafe tree_model_iter_n_children#} (toTreeModel tm) 
    (fromMaybe (TreeIter nullForeignPtr) iter)

-- | Retrieve the @n@th child.
--
-- * If @Nothing@ is specified for the @tm@ argument, the
--   function will work on toplevel elements.
--
treeModelIterNthChild :: TreeModelClass tm => 
  tm -> Maybe TreeIter -> Int -> IO (Maybe TreeIter)
treeModelIterNthChild tm parent n = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  res <- {#call unsafe tree_model_iter_nth_child#} (toTreeModel tm) iter 
    (fromMaybe (TreeIter nullForeignPtr) parent) (fromIntegral n)
  return $ if (toBool res) then Just iter else Nothing

-- | Retrieve the parent of this iterator.
--
treeModelIterParent :: TreeModelClass tm => tm -> 
  TreeIter -> IO (Maybe TreeIter)
treeModelIterParent tm child = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  res <- {#call unsafe tree_model_iter_parent#} (toTreeModel tm) iter child
  return $ if (toBool res) then Just iter else Nothing

-- | No clue.
--
treeModelRefNode :: TreeModelClass tm => tm -> TreeIter -> IO ()
treeModelRefNode tm iter = 
  {#call unsafe tree_model_ref_node#} (toTreeModel tm) iter

-- | No clue either.
--
treeModelUnrefNode :: TreeModelClass tm => tm -> TreeIter -> IO ()
treeModelUnrefNode tm iter = 
  {#call unsafe tree_model_unref_node#} (toTreeModel tm) iter

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/TreeList TreeViewColumn.chs,NONE,1.1 TreeSelection.chs,NONE,1.1 TreeModelSort.chs,NONE,1.1

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

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

Added Files:
	TreeViewColumn.chs TreeSelection.chs TreeModelSort.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: TreeSelection.chs ---
{-# OPTIONS -cpp #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TreeSelection
--
--  Author : Axel Simon
--          
--  Created: 8 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:34:40 $
--
--  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 'TreeSelection' is a data type belonging to a 'TreeModel'. As the name
-- suggests it holds the current selection which can even be a multiple
-- choice.
--
-- TODO
--
-- * treeSelectionGetSelected allows to retreive the associated TreeModel
--   object. We currently do not use this feature so it could be added
--   if needed.
--
module Graphics.UI.Gtk.TreeList.TreeSelection (
  TreeSelection,
  TreeSelectionClass,
  castToTreeSelection,
  SelectionMode(..),
  treeSelectionSetMode,
  treeSelectionGetMode,
  TreeSelectionCB,
  treeSelectionSetSelectFunction,
  treeSelectionGetTreeView,
  treeSelectionGetSelected,
  TreeSelectionForeachCB,
  treeSelectionSelectedForeach,
  treeSelectionSelectPath,
  treeSelectionUnselectPath,
  treeSelectionPathIsSelected,
  treeSelectionSelectIter,
  treeSelectionUnselectIter,
  treeSelectionIterIsSelected,
  treeSelectionSelectAll,
  treeSelectionUnselectAll,
  treeSelectionSelectRange,
  onSelectionChanged,
  afterSelectionChanged
  ) where

import Monad	(liftM)
import Data.IORef (newIORef, readIORef, writeIORef)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums    (SelectionMode(..))
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
import Graphics.UI.Gtk.General.Structs	(treeIterSize)
import Graphics.UI.Gtk.General.General	(mkDestructor)

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

-- methods

-- | Set single or multiple choice.
--
treeSelectionSetMode :: (TreeSelectionClass ts) => ts -> SelectionMode -> IO ()
treeSelectionSetMode ts sm = {#call tree_selection_set_mode#}
  (toTreeSelection ts) ((fromIntegral.fromEnum) sm)

-- | Gets the selection mode.
--
treeSelectionGetMode :: (TreeSelectionClass ts) => ts -> IO SelectionMode
treeSelectionGetMode ts = liftM (toEnum.fromIntegral) $
  {#call unsafe tree_selection_get_mode#} (toTreeSelection ts)

-- | Set a callback function if selection changes.
--
treeSelectionSetSelectFunction :: (TreeSelectionClass ts) => ts ->
                                  TreeSelectionCB -> IO ()
treeSelectionSetSelectFunction ts fun = do
  fPtr <- mkTreeSelectionFunc (\_ _ tp _ -> do
    tpPtr <- tree_path_copy tp
    path <- liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr)
    fun path
    )
  dRef <- newIORef nullFunPtr
  dPtr <- mkDestructor $ do
    dPtr <- readIORef dRef
    freeHaskellFunPtr dPtr
    freeHaskellFunPtr fPtr
  writeIORef dRef dPtr
  {#call tree_selection_set_select_function#} (toTreeSelection ts) fPtr 
    nullPtr dPtr

-- | Callback type for a function that is called everytime the selection
-- changes. This function is set with 'treeSelectionSetSelectFunction'.
--
type TreeSelectionCB = TreePath -> IO ()
{#pointer TreeSelectionFunc#}

foreign import ccall "wrapper"  mkTreeSelectionFunc ::
  (Ptr () -> Ptr () -> Ptr TreePath -> Ptr () -> IO ())-> IO TreeSelectionFunc

-- | Retrieve the 'TreeView' widget that this 'TreeSelection' works on.
--
treeSelectionGetTreeView :: (TreeSelectionClass ts) => ts -> IO TreeView
treeSelectionGetTreeView ts = makeNewObject mkTreeView $
  {#call unsafe tree_selection_get_tree_view#} (toTreeSelection ts)

-- | Retrieves the selection of a single choice 'TreeSelection'.
--
treeSelectionGetSelected :: (TreeSelectionClass ts) => ts ->
                            IO (Maybe TreeIter)
treeSelectionGetSelected ts = do
  iterPtr <- mallocBytes treeIterSize
  iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
  res <- {#call tree_selection_get_selected#} (toTreeSelection ts) 
    (nullPtr) iter
  return $ if (toBool res) then Just iter else Nothing

-- | Execute a function for each selected node.
--
treeSelectionSelectedForeach :: (TreeSelectionClass ts) => ts ->
                                TreeSelectionForeachCB -> IO ()
treeSelectionSelectedForeach ts fun = do
  fPtr <- mkTreeSelectionForeachFunc (\_ ti _ -> do
    -- make a deep copy of the iterator. This makes it possible to store this
    -- iterator in Haskell land somewhere. The TreeModel parameter is not
    -- passed to the function due to performance reasons. But since it is
    -- a constant member of Selection this does not matter.
    iterPtr <- mallocBytes treeIterSize
    copyBytes iterPtr ti treeIterSize
    iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr)
    fun iter
    )
  {#call tree_selection_selected_foreach#} (toTreeSelection ts) fPtr nullPtr
  freeHaskellFunPtr fPtr

-- | Callback function type for 'treeSelectionSelectedForeach'.
--
type TreeSelectionForeachCB = TreeIter -> IO ()
{#pointer TreeSelectionForeachFunc#}

foreign import ccall "wrapper"  mkTreeSelectionForeachFunc ::
  (Ptr () -> Ptr TreeIter -> Ptr () -> IO ()) -> IO TreeSelectionForeachFunc

-- | Select a specific item by 'TreePath'.
--
treeSelectionSelectPath :: (TreeSelectionClass ts) => ts -> TreePath -> IO ()
treeSelectionSelectPath ts tp =
  {#call tree_selection_select_path#} (toTreeSelection ts) tp

-- | Deselect a specific item by 'TreePath'.
--
treeSelectionUnselectPath :: (TreeSelectionClass ts) => ts -> TreePath -> IO ()
treeSelectionUnselectPath ts tp =
  {#call tree_selection_unselect_path#} (toTreeSelection ts) tp

-- | Returns True if the row at the given path is currently selected.
--
treeSelectionPathIsSelected :: (TreeSelectionClass ts) => ts -> TreePath -> IO Bool
treeSelectionPathIsSelected ts tp = liftM toBool $
  {#call unsafe tree_selection_path_is_selected#} (toTreeSelection ts) tp

-- | Select a specific item by 'TreeIter'.
--
treeSelectionSelectIter :: (TreeSelectionClass ts) => ts -> TreeIter -> IO ()
treeSelectionSelectIter ts ti =
  {#call tree_selection_select_iter#} (toTreeSelection ts) ti

-- | Deselect a specific item by 'TreeIter'.
--
treeSelectionUnselectIter :: (TreeSelectionClass ts) => ts -> TreeIter -> IO ()
treeSelectionUnselectIter ts ti =
  {#call tree_selection_unselect_iter#} (toTreeSelection ts) ti

-- | Returns True if the row at the given iter is currently selected.
--
treeSelectionIterIsSelected :: (TreeSelectionClass ts) => ts -> TreeIter -> IO Bool
treeSelectionIterIsSelected ts ti = liftM toBool $
  {#call unsafe tree_selection_iter_is_selected#} (toTreeSelection ts) ti

-- | Select everything.
--
treeSelectionSelectAll :: (TreeSelectionClass ts) => ts -> IO ()
treeSelectionSelectAll ts = 
  {#call tree_selection_select_all#} (toTreeSelection ts)

-- | Deselect everything.
--
treeSelectionUnselectAll :: (TreeSelectionClass ts) => ts -> IO ()
treeSelectionUnselectAll ts = 
  {#call tree_selection_unselect_all#} (toTreeSelection ts)


-- | Select a range specified by two 'TreePath's.
--
treeSelectionSelectRange :: (TreeSelectionClass ts) => ts -> TreePath ->
                            TreePath -> IO ()
treeSelectionSelectRange ts start end =
  {#call tree_selection_select_range#} (toTreeSelection ts) start end


-- | Emitted each time the user changes the selection.
--
onSelectionChanged, afterSelectionChanged :: TreeSelectionClass ts => ts -> (IO ()) ->
			   IO (ConnectId ts)
onSelectionChanged = connect_NONE__NONE "changed" False
afterSelectionChanged = connect_NONE__NONE "changed" True


--- NEW FILE: TreeModelSort.chs ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) TreeModelSort
--
--  Author : Duncan Coutts
--  Created: 4 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
-- 
-- The 'TreeModelSort' is a model that turns any object that implements the
-- 'TreeModel' interface into a store that is sorted.
--
-- It does not hold any data itself, but rather is created with a child model
-- and proxies its data. It has identical column types to this child model, and
-- the changes in the child are propagated. The primary purpose of this model is
-- to provide a way to sort a different model without modifying it.
--

module Graphics.UI.Gtk.TreeList.TreeModelSort  (
  TreeModelSort,
  TreeModelSortClass,
  treeModelSortNewWithModel,
  treeModelSortGetModel,
  treeModelSortConvertChildPathToPath,
  treeModelSortConvertPathToChildPath,
  treeModelSortConvertChildIterToIter,
  treeModelSortConvertIterToChildIter,  
  treeModelSortResetDefaultSortFunc
  ) where

import Monad	(liftM, when)

import System.Glib.FFI
import System.Glib.GObject			(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
import Graphics.UI.Gtk.General.Structs		(treeIterSize)

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


-- | Creates a new 'TreeModelSort', that will be a sorted view of the given
-- model.
--
treeModelSortNewWithModel :: TreeModelClass tm => tm -> IO TreeModelSort
treeModelSortNewWithModel model =
  makeNewGObject mkTreeModelSort $ liftM castPtr $
  {#call unsafe tree_model_sort_new_with_model#} (toTreeModel model)

-- | Returns the underlying model the 'TreeModelSort' is sorting.
--
treeModelSortGetModel :: TreeModelSortClass obj => obj -> IO TreeModel
treeModelSortGetModel obj =
  makeNewGObject mkTreeModel $
  {#call tree_model_sort_get_model#} (toTreeModelSort obj)

-- | Converts the given path to a path relative to the given sorted model. That
-- is, the given path points to a row in the child model. The returned path will
-- point to the same row in the sorted model.
--
treeModelSortConvertChildPathToPath :: TreeModelSortClass obj => obj
                                    -> TreePath -> IO TreePath
treeModelSortConvertChildPathToPath obj childPath = do
  pathPtr <-
    throwIfNull "treeModelSortConvertChildPathToPath: invalid path given" $ 
    {#call unsafe tree_model_sort_convert_child_path_to_path#}
    (toTreeModelSort obj) childPath
  liftM TreePath $ newForeignPtr pathPtr (tree_path_free pathPtr)

-- | Converts path in the sorted model to a path on the unsorted model on which
-- the given 'TreeModelSort' is based. That is, the given path points to a
-- location in the given 'TreeModelSort'. The returned path will point to the
-- same location in the underlying unsorted model.
--
treeModelSortConvertPathToChildPath :: TreeModelSortClass obj => obj
                                    -> TreePath -> IO TreePath
treeModelSortConvertPathToChildPath obj sortedPath = do
  pathPtr <-
    throwIfNull "treeModelSortConvertPathToChildPath: invalid path given" $ 
    {#call unsafe tree_model_sort_convert_path_to_child_path#}
    (toTreeModelSort obj) sortedPath
  liftM TreePath $ newForeignPtr pathPtr (tree_path_free pathPtr)

-- | Return an iterator in the sorted model that points to the row pointed to
-- by the given iter from the unsorted model.
--
treeModelSortConvertChildIterToIter :: TreeModelSortClass obj => obj
                                    -> TreeIter -> IO TreeIter
treeModelSortConvertChildIterToIter obj childIter = do
  sortIterPtr <- mallocBytes treeIterSize
  sortIter <- liftM TreeIter $ newForeignPtr sortIterPtr
                (foreignFree sortIterPtr)
  {#call tree_model_sort_convert_child_iter_to_iter#} (toTreeModelSort obj)
    sortIter childIter
  return sortIter

-- | Return an iterator in the unsorted model that points to the row pointed to
-- by the given iter from the sorted model.
--
treeModelSortConvertIterToChildIter :: TreeModelSortClass obj => obj
                                    -> TreeIter -> IO TreeIter
treeModelSortConvertIterToChildIter obj sortedIter = do
  childIterPtr <- mallocBytes treeIterSize
  childIter <- liftM TreeIter $ newForeignPtr childIterPtr
                 (foreignFree childIterPtr)
  {#call unsafe tree_model_sort_convert_iter_to_child_iter#}
    (toTreeModelSort obj) childIter sortedIter
  return childIter

-- | This resets the default sort function to be in the \'unsorted\' state. That
-- is, it is in the same order as the child model. It will re-sort the model to
-- be in the same order as the child model only if the 'TreeModelSort' is in 
-- \'unsorted\' state.
--
treeModelSortResetDefaultSortFunc :: TreeModelSortClass obj => obj -> IO ()
treeModelSortResetDefaultSortFunc obj =
  {#call tree_model_sort_reset_default_sort_func#} (toTreeModelSort obj)

--- NEW FILE: TreeViewColumn.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TreeViewColumn TreeView
--
--  Author : Axel Simon
--          
--  Created: 9 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:34:40 $
--
--  Copyright (c) 2001 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.
--
-- |
--
-- * tree_view_column_new_with_attributes and tree_view_column_set_attributes 
--   are variadic and the funcitonality can be achieved through other 
--   functions.
--
-- * tree_view_column_set_cell_data and tree_view_column_cell_get_size are not
--   bound because I am not sure what they do and when they are useful
--
-- TODO
--
-- * treeViewColumnSetCellData is not bound. With this function the user has
--   control over how data in the store is mapped to the attributes of a
--   cell renderer. This functin should be bound in the future to allow the
--   user to insert Haskell data types into the store and convert these
--   values to attributes of cell renderers.
--
module Graphics.UI.Gtk.TreeList.TreeViewColumn (
  TreeViewColumn,
  TreeViewColumnClass,
  castToTreeViewColumn,
  treeViewColumnNew,
  treeViewColumnNewWithAttributes,
  treeViewColumnPackStart,
  treeViewColumnPackEnd,
  treeViewColumnClear,
  treeViewColumnGetCellRenderers,
  treeViewColumnAddAttribute,
  treeViewColumnAddAttributes,
  treeViewColumnSetAttributes,
  treeViewColumnClearAttributes,
  treeViewColumnSetSpacing,
  treeViewColumnGetSpacing,
  treeViewColumnSetVisible,
  treeViewColumnGetVisible,
  treeViewColumnSetResizable,
  treeViewColumnGetResizable,
  TreeViewColumnSizing(..),
  treeViewColumnSetSizing,
  treeViewColumnGetSizing,
  treeViewColumnGetWidth,
  treeViewColumnSetFixedWidth,
  treeViewColumnGetFixedWidth,
  treeViewColumnSetMinWidth,
  treeViewColumnGetMinWidth,
  treeViewColumnSetMaxWidth,
  treeViewColumnGetMaxWidth,
  treeViewColumnClicked,
  treeViewColumnSetTitle,
  treeViewColumnGetTitle,
  treeViewColumnSetClickable,
  treeViewColumnGetClickable,
  treeViewColumnSetWidget,
  treeViewColumnGetWidget,
  treeViewColumnSetAlignment,
  treeViewColumnGetAlignment,
  treeViewColumnSetReorderable,
  treeViewColumnGetReorderable,
  treeViewColumnSetSortColumnId,
  treeViewColumnGetSortColumnId,
  treeViewColumnSetSortIndicator,
  treeViewColumnGetSortIndicator,
  treeViewColumnSetSortOrder,
  treeViewColumnGetSortOrder,
  SortType(..),
  onColClicked,
  afterColClicked
  ) 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		(TreeViewColumnSizing(..), SortType(..))
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
import Graphics.UI.Gtk.TreeList.CellRenderer	(Attribute(..))
{#import System.Glib.GList#}

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

-- TreeViewColumn type declaration

-- methods

-- | Generate a new TreeViewColumn widget.
--
treeViewColumnNew :: IO TreeViewColumn
treeViewColumnNew  = makeNewObject mkTreeViewColumn 
  {#call tree_view_column_new#}

-- | Returns a new TreeViewColumn with title @title@, cell renderer @cr@, and
-- attributes @attribs@.
--
treeViewColumnNewWithAttributes :: CellRendererClass cr => String -> cr -> 
				   [(String, Int)] -> IO TreeViewColumn
treeViewColumnNewWithAttributes title cr attribs =
    do
    tvc <- treeViewColumnNew
    treeViewColumnSetTitle tvc title
    treeViewColumnPackStart tvc  cr True
    treeViewColumnAddAttributes tvc cr attribs
    return tvc

-- | Add a cell renderer at the beginning of
-- a column.
--
-- * Excess space is divided equally among all renderers which have
--   @expand@ set to True.
--
treeViewColumnPackStart :: (TreeViewColumnClass tvc, CellRendererClass cr) =>
			   tvc -> cr -> Bool -> IO ()
treeViewColumnPackStart tvc cr expand = 
  {#call unsafe tree_view_column_pack_start#} (toTreeViewColumn tvc)
  (toCellRenderer cr) (fromBool expand)

-- | Add a cell renderer at the end of a column.
--
-- * Excess space is divided equally among all renderers which have
--   @expand@ set to True.
--
treeViewColumnPackEnd :: (TreeViewColumnClass tvc, CellRendererClass cr) =>
			 tvc -> cr -> Bool -> IO ()
treeViewColumnPackEnd tvc cr expand = 
  {#call unsafe tree_view_column_pack_end#} (toTreeViewColumn tvc)
  (toCellRenderer cr) (fromBool expand)

-- | Remove the associations of attributes
-- to a store for all 'CellRenderers'.
--
treeViewColumnClear :: TreeViewColumnClass tvc => tvc -> IO ()
treeViewColumnClear tvc = 
  {#call tree_view_column_clear#} (toTreeViewColumn tvc)

-- | Retrieve all 
-- 'CellRenderer's that are contained in this column.
--
treeViewColumnGetCellRenderers :: TreeViewColumnClass tvc => 
				  tvc -> IO [CellRenderer]
treeViewColumnGetCellRenderers tvc = do
  glist <- {#call unsafe tree_view_column_get_cell_renderers#} 
	   (toTreeViewColumn tvc)
  crs <- fromGList glist
  mapM (makeNewObject mkCellRenderer) (map return crs)

-- | Insert an attribute to change the
-- behaviour of the column's cell renderer.
--
-- * The 'CellRenderer' @cr@ must already be in 
--   'TreeViewColumn'.
--
treeViewColumnAddAttribute :: (TreeViewColumnClass tvc, CellRendererClass cr)
			      => tvc -> cr -> String -> Int -> IO ()
treeViewColumnAddAttribute tvc cr attr col = 
  withUTFString attr $ \cstr ->  {#call unsafe tree_view_column_add_attribute#} 
    (toTreeViewColumn tvc) (toCellRenderer cr) cstr (fromIntegral col)

-- | Insert attributes @attribs@
-- to change the behaviour of column @tvc@'s cell renderer
-- @cr@.
--
treeViewColumnAddAttributes :: 
  (TreeViewColumnClass tvc, CellRendererClass cr) => 
  tvc -> cr -> [(String,Int)] -> IO ()
treeViewColumnAddAttributes tvc cr attribs = 
    mapM_ (\ (attr, col) -> treeViewColumnAddAttribute tvc cr attr col) attribs

-- | Set the attributes of
-- the cell renderer @cr@ in the tree column @tvc@
-- be  @attribs@.
-- The attributes are given as a list of attribute\/column pairs.
-- All existing attributes are removed, and replaced with the new attributes.
--
treeViewColumnSetAttributes :: 
    (TreeViewColumnClass tvc, CellRendererClass cr)  =>
    tvc -> cr -> [(String, Int)] -> IO ()
treeViewColumnSetAttributes tvc cr attribs =
    do
    treeViewColumnClearAttributes tvc cr
    treeViewColumnAddAttributes tvc cr attribs

-- | Clears all existing attributes
-- of the column @tvc@.
--
treeViewColumnClearAttributes :: 
    (TreeViewColumnClass tvc, CellRendererClass cr) =>
    tvc -> cr -> IO ()
treeViewColumnClearAttributes tvc cr =
  {#call tree_view_column_clear_attributes#} (toTreeViewColumn tvc)
    (toCellRenderer cr)


-- | Set the number of pixels between two
-- cell renderers.
--
treeViewColumnSetSpacing :: TreeViewColumnClass tvc => tvc -> Int -> IO ()
treeViewColumnSetSpacing tvc vis =
  {#call tree_view_column_set_spacing#} (toTreeViewColumn tvc) 
    (fromIntegral vis)


-- | Get the number of pixels between two
-- cell renderers.
--
treeViewColumnGetSpacing :: TreeViewColumnClass tvc => tvc -> IO Int
treeViewColumnGetSpacing tvc = liftM fromIntegral $
  {#call unsafe tree_view_column_get_spacing#} (toTreeViewColumn tvc)


-- | Set the visibility of a given column.
--
treeViewColumnSetVisible :: TreeViewColumnClass tvc => tvc -> Bool -> IO ()
treeViewColumnSetVisible tvc vis =
  {#call tree_view_column_set_visible#} (toTreeViewColumn tvc) 
    (fromBool vis)


-- | Get the visibility of a given column.
--
treeViewColumnGetVisible :: TreeViewColumnClass tvc => tvc -> IO Bool
treeViewColumnGetVisible tvc = liftM toBool $
  {#call unsafe tree_view_column_get_visible#} (toTreeViewColumn tvc)


-- | Set if a given column is resizable
-- by the user.
--
treeViewColumnSetResizable :: TreeViewColumnClass tvc => tvc -> Bool -> IO ()
treeViewColumnSetResizable tvc vis =
  {#call tree_view_column_set_resizable#} (toTreeViewColumn tvc) 
    (fromBool vis)


-- | Get if a given column is resizable
-- by the user.
--
treeViewColumnGetResizable :: TreeViewColumnClass tvc => tvc -> IO Bool
treeViewColumnGetResizable tvc = liftM toBool $
  {#call unsafe tree_view_column_get_resizable#} (toTreeViewColumn tvc)


-- | Set wether the column can be resized.
--
treeViewColumnSetSizing :: TreeViewColumnClass tvc => tvc ->
                           TreeViewColumnSizing -> IO ()
treeViewColumnSetSizing tvc size = {#call tree_view_column_set_sizing#} 
  (toTreeViewColumn tvc) ((fromIntegral.fromEnum) size)


-- | Return the resizing type of the column.
--
treeViewColumnGetSizing :: TreeViewColumnClass tvc => tvc ->
                           IO TreeViewColumnSizing
treeViewColumnGetSizing tvc = liftM (toEnum.fromIntegral) $
  {#call unsafe tree_view_column_get_sizing#} (toTreeViewColumn tvc)


-- | Query the current width of the column.
--
treeViewColumnGetWidth :: TreeViewColumnClass tvc => tvc -> IO Int
treeViewColumnGetWidth tvc = liftM fromIntegral $
  {#call unsafe tree_view_column_get_width#} (toTreeViewColumn tvc)


-- | Set the width of the column.
--
-- * This is meaningful only if the sizing type is 'TreeViewColumnFixed'.
--
treeViewColumnSetFixedWidth :: TreeViewColumnClass tvc => tvc -> Int -> IO ()
treeViewColumnSetFixedWidth tvc width = 
  {#call tree_view_column_set_fixed_width#} 
  (toTreeViewColumn tvc) (fromIntegral width)


-- | Gets the fixed width of the column.
--
-- * This is meaningful only if the sizing type is 'TreeViewColumnFixed'.
--
-- * This value is only meaning may not be the actual width of the column on the
-- screen, just what is requested.
--
treeViewColumnGetFixedWidth :: TreeViewColumnClass tvc => tvc -> IO Int
treeViewColumnGetFixedWidth tvc = liftM fromIntegral $
  {#call unsafe tree_view_column_get_fixed_width#} (toTreeViewColumn tvc)


-- | Set minimum width of the column.
--
treeViewColumnSetMinWidth :: TreeViewColumnClass tvc => tvc -> Int -> IO ()
treeViewColumnSetMinWidth tvc width = {#call tree_view_column_set_min_width#} 
  (toTreeViewColumn tvc) (fromIntegral width)

-- | Get the minimum width of a column.
-- Returns -1 if this width was not set.
--
treeViewColumnGetMinWidth :: TreeViewColumnClass tvc => tvc -> IO Int
treeViewColumnGetMinWidth tvc = liftM fromIntegral $
  {#call unsafe tree_view_column_get_min_width#} (toTreeViewColumn tvc)

-- | Set maximum width of the column.
--
treeViewColumnSetMaxWidth :: TreeViewColumnClass tvc => tvc -> Int -> IO ()
treeViewColumnSetMaxWidth tvc width = {#call tree_view_column_set_max_width#} 
  (toTreeViewColumn tvc) (fromIntegral width)

-- | Get the maximum width of a column.
-- Returns -1 if this width was not set.
--
treeViewColumnGetMaxWidth :: TreeViewColumnClass tvc => tvc -> IO Int
treeViewColumnGetMaxWidth tvc = liftM fromIntegral $
  {#call unsafe tree_view_column_get_max_width#} (toTreeViewColumn tvc)

-- | Emit the @clicked@ signal on the
-- column.
--
treeViewColumnClicked :: TreeViewColumnClass tvc => tvc -> IO ()
treeViewColumnClicked tvc =
  {#call tree_view_column_clicked#} (toTreeViewColumn tvc)

-- | Set the widget's title if a custom widget
-- has not been set.
--
treeViewColumnSetTitle :: TreeViewColumnClass tvc => tvc -> String -> IO ()
treeViewColumnSetTitle tvc title = withUTFString title $
  {#call tree_view_column_set_title#} (toTreeViewColumn tvc)

-- | Get the widget's title.
--
treeViewColumnGetTitle :: TreeViewColumnClass tvc => tvc -> IO (Maybe String)
treeViewColumnGetTitle tvc = do
  strPtr <- {#call unsafe tree_view_column_get_title#} (toTreeViewColumn tvc)
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Set if the column should be sensitive to mouse clicks.
--
treeViewColumnSetClickable :: TreeViewColumnClass tvc => tvc -> Bool -> IO ()
treeViewColumnSetClickable tvc click = {#call tree_view_column_set_clickable#} 
  (toTreeViewColumn tvc) (fromBool click)

-- | Returns True if the user can click on the header for the column.
--
treeViewColumnGetClickable :: TreeViewColumnClass tvc => tvc -> IO Bool
treeViewColumnGetClickable tvc = liftM toBool $
  {#call tree_view_column_get_clickable#} (toTreeViewColumn tvc)

-- | Set the column's title to this widget.
--
treeViewColumnSetWidget :: (TreeViewColumnClass tvc, WidgetClass w) => tvc ->
                           w -> IO ()
treeViewColumnSetWidget tvc w =
  {#call tree_view_column_set_widget#} (toTreeViewColumn tvc) (toWidget w)

-- | Retrieve the widget responsible for
-- showing the column title. In case only a text title was set this will be a
-- 'Alignment' widget with a 'Label' inside.
--
treeViewColumnGetWidget :: TreeViewColumnClass tvc => tvc -> IO Widget
treeViewColumnGetWidget tvc = makeNewObject mkWidget $
  {#call unsafe tree_view_column_get_widget#} (toTreeViewColumn tvc)

-- | Set the alignment of the title.
--
treeViewColumnSetAlignment :: TreeViewColumnClass tvc => tvc -> Float -> IO ()
treeViewColumnSetAlignment tvc align = {#call tree_view_column_set_alignment#}
  (toTreeViewColumn tvc) (realToFrac align)

-- | Get the alignment of the titlte.
--
treeViewColumnGetAlignment :: TreeViewColumnClass tvc => tvc -> IO Float
treeViewColumnGetAlignment tvc = liftM realToFrac $
  {#call unsafe tree_view_column_get_alignment#} (toTreeViewColumn tvc)

-- | Set if a given column is reorderable
-- by the user.
--
treeViewColumnSetReorderable :: TreeViewColumnClass tvc => tvc -> Bool -> IO ()
treeViewColumnSetReorderable tvc vis =
  {#call tree_view_column_set_reorderable#} (toTreeViewColumn tvc) 
    (fromBool vis)

-- | Get if a given column is reorderable
-- by the user.
--
treeViewColumnGetReorderable :: TreeViewColumnClass tvc => tvc -> IO Bool
treeViewColumnGetReorderable tvc = liftM toBool $
  {#call unsafe tree_view_column_get_reorderable#} (toTreeViewColumn tvc)

-- | Set the column by which to sort.
--
-- * Sets the logical @columnId@ that this column sorts on when
--   this column is selected for sorting. The selected column's header
--   will be clickable after this call. Logical refers to the column in
--   the 'TreeModel'.
--
treeViewColumnSetSortColumnId :: TreeViewColumnClass tvc => 
				 tvc -> Int -> IO ()
treeViewColumnSetSortColumnId tvc columnId = 
  {#call tree_view_column_set_sort_column_id#} 
  (toTreeViewColumn tvc) (fromIntegral columnId)

-- | Get the column by which to sort.
--
-- * Retrieves the logical @columnId@ that the model sorts on when
--   this column is selected for sorting.
--
-- * Returns -1 if this column can't be used for sorting.
--
treeViewColumnGetSortColumnId :: TreeViewColumnClass tvc => tvc -> IO Int
treeViewColumnGetSortColumnId tvc = liftM fromIntegral $
  {#call unsafe tree_view_column_get_sort_column_id#} (toTreeViewColumn tvc)

-- | Set if a given column has
-- sorting arrows in its heading.
--
treeViewColumnSetSortIndicator :: TreeViewColumnClass tvc => 
				  tvc -> Bool -> IO ()
treeViewColumnSetSortIndicator tvc sort =
  {#call tree_view_column_set_sort_indicator#} (toTreeViewColumn tvc) 
    (fromBool sort)

-- | Query if a given column has
-- sorting arrows in its heading.
--
treeViewColumnGetSortIndicator :: TreeViewColumnClass tvc => tvc -> IO Bool
treeViewColumnGetSortIndicator tvc = liftM toBool $
  {#call unsafe tree_view_column_get_sort_indicator#} (toTreeViewColumn tvc)

-- | Set if a given column is sorted
-- in ascending or descending order.
--
-- * In order for sorting to work, it is necessary to either use automatic
--   sorting via 'treeViewColumnSetSortColumnId' or to use a
--   user defined sorting on the elements in a 'TreeModel'.
--
treeViewColumnSetSortOrder :: TreeViewColumnClass tvc => 
			      tvc -> SortType -> IO ()
treeViewColumnSetSortOrder tvc sort =
  {#call tree_view_column_set_sort_order#} (toTreeViewColumn tvc) 
    ((fromIntegral.fromEnum) sort)

-- | Query if a given column is sorted
-- in ascending or descending order.
--
treeViewColumnGetSortOrder :: TreeViewColumnClass tvc => tvc -> IO SortType
treeViewColumnGetSortOrder tvc = liftM (toEnum.fromIntegral) $
  {#call unsafe tree_view_column_get_sort_order#} (toTreeViewColumn tvc)

-- | Emitted when the header of this column has been
-- clicked on.
--
onColClicked, afterColClicked :: TreeViewColumnClass tvc => tvc -> IO () -> 
							    IO (ConnectId tvc)
onColClicked = connect_NONE__NONE "clicked" False
afterColClicked = connect_NONE__NONE "clicked" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/TreeList TreeView.chs.pp,NONE,1.1

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

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

Added Files:
	TreeView.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: TreeView.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget TreeView
--
--  Author : Axel Simon
--          
--  Created: 9 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:33:48 $
--
--  Copyright (c) 2001 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 constitutes the main widget for displaying lists and other
-- structured data.
--
-- * The widget supports scrolling natively. This implies that pixel 
--   coordinates can be given in two formats: relative to the current view's
--   upper left corner or relative to the whole list's coordinates. The former
--   are called widget coordinates while the letter are called tree 
--   coordinates.
--
-- TODO
--
-- * treeViewMoveColumnAfter and treeViewMoveColumnFirst are not dealt with in
--   Mogul
--
-- * gtk_tree_view_get_bin_window is to compare the GDK window from incoming
--   events. We don't marshal that window parameter, so this function is not
--   bound either.
--
-- * All functions related to drag and drop are missing.
--
-- * get_search_equal_func is missing: proper memory management is impossible
--
-- * gtk_tree_view_set_destroy_count_func is not meant to be useful
--
-- * expand-collapse-cursor-row needs to be bound if it is useful to expand
--   and collapse rows in a user-defined manner. Would only work on Gtk 2.2
--   and higher since the return parameter changed
--
-- * move_cursor, select_all, select_cursor_parent, select_cursor_row
--   toggle_cursor_row, unselect_all are not bound.
--   These functions are only useful to change the widgets
--   behaviour for these actions. Everything else can be done with
--   cursor_changed and columns_changed
--
-- * set_scroll_adjustment makes sense if the user monitors the scroll bars
--   *and* the scroll bars can be replaced anytime (the latter is odd)
--
module Graphics.UI.Gtk.TreeList.TreeView (
  TreeView,
  TreeViewClass,
  castToTreeView,
  treeViewNew,
  treeViewNewWithModel,
  treeViewGetModel,
  treeViewSetModel,
  treeViewGetSelection,
  treeViewGetHadjustment,
  treeViewSetHadjustment,
  treeViewGetVadjustment,
  treeViewSetVadjustment,
  treeViewGetHeadersVisible,
  treeViewSetHeadersVisible,
  treeViewColumnsAutosize,
  treeViewSetHeadersClickable,
  treeViewGetRulesHint,
  treeViewSetRulesHint,
  treeViewAppendColumn,
  treeViewRemoveColumn,
  treeViewInsertColumn,
  treeViewInsertColumnWithAttributes,
  treeViewGetColumn,
  treeViewGetColumns,
  treeViewMoveColumnAfter,
  treeViewMoveColumnFirst,
  treeViewSetExpanderColumn,
  treeViewGetExpanderColumn,
  treeViewSetColumnDragFunction,
  treeViewScrollToPoint,
  treeViewScrollToCell,
  treeViewSetCursor,
#if GTK_CHECK_VERSION(2,2,0)
  treeViewSetCursorOnCell,
#endif
  treeViewGetCursor,
  treeViewRowActivated,
  treeViewExpandAll,
  treeViewCollapseAll,
#if GTK_CHECK_VERSION(2,2,0)
  treeViewExpandToPath,
#endif
  treeViewExpandRow,
  treeViewCollapseRow,
  treeViewMapExpandedRows,
  treeViewRowExpanded,
  treeViewGetReorderable,
  treeViewSetReorderable,
  Point,
  treeViewGetPathAtPos,
  treeViewGetCellArea,
  treeViewGetBackgroundArea,
  treeViewGetVisibleRect,
  treeViewWidgetToTreeCoords,
  treeViewTreeToWidgetCoords,
  treeViewCreateRowDragIcon,
  treeViewGetEnableSearch,
  treeViewSetEnableSearch,
  treeViewGetSearchColumn,
  treeViewSetSearchColumn,
  treeViewSetSearchEqualFunc,
  onColumnsChanged,
  afterColumnsChanged,
  onCursorChanged,
  afterCursorChanged,
  onRowActivated,
  afterRowActivated,
  onRowCollapsed,
  afterRowCollapsed,
  onRowExpanded,
  afterRowExpanded,
  onStartInteractiveSearch,
  afterStartInteractiveSearch,
  onTestCollapseRow,
  afterTestCollapseRow,
  onTestExpandRow,
  afterTestExpandRow
  ) where

import Monad	(liftM, mapM)
import Maybe	(fromMaybe)
import Data.IORef (newIORef, readIORef, writeIORef)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.General.General	(mkDestructor)
import Graphics.UI.Gtk.General.Structs	(Point, Rectangle)
import System.Glib.GObject		(makeNewGObject)
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import System.Glib.GList		(GList, fromGList)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeModel#}
{#import Graphics.UI.Gtk.TreeList.TreeViewColumn#}

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

-- methods

-- | Make a new 'TreeView' widget.
--
treeViewNew :: IO TreeView
treeViewNew  = makeNewObject mkTreeView (liftM castPtr {#call tree_view_new#})

-- | Create a new 'TreeView' 
-- widget with @tm@ as the storage model.
--
treeViewNewWithModel :: TreeModelClass tm => tm -> IO TreeView
treeViewNewWithModel tm = makeNewObject mkTreeView $ liftM castPtr $
  {#call tree_view_new_with_model#} (toTreeModel tm)

-- | Retrieve the TreeModel that supplies the data for
-- this 'TreeView'. Returns Nothing if no model is currently set.
--
treeViewGetModel :: TreeViewClass tv => tv -> IO (Maybe TreeModel)
treeViewGetModel tv = do
  tmPtr <- {#call unsafe tree_view_get_model#} (toTreeView tv)
  if tmPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkTreeModel (return tmPtr)

-- | Set the 'TreeModel' for the current View.
--
treeViewSetModel :: (TreeViewClass tv, TreeModelClass tm) => tv -> tm -> IO ()
treeViewSetModel tv tm =
  {#call tree_view_set_model#} (toTreeView tv) (toTreeModel tm)

-- | Retrieve a 'TreeSelection' that
-- holds the current selected nodes of the View.
--
treeViewGetSelection :: TreeViewClass tv => tv -> IO TreeSelection
treeViewGetSelection tv = makeNewGObject mkTreeSelection $
  {#call unsafe tree_view_get_selection#} (toTreeView tv)

-- | Get the 'Adjustment' that
-- represents the horizontal aspect.
--
treeViewGetHadjustment :: TreeViewClass tv => tv -> IO (Maybe Adjustment)
treeViewGetHadjustment tv = do
  adjPtr <- {#call unsafe tree_view_get_hadjustment#} (toTreeView tv)
  if adjPtr==nullPtr then return Nothing else do
    liftM Just $ makeNewObject mkAdjustment (return adjPtr)

-- | Set the 'Adjustment' that controls
-- the horizontal aspect. If @adj@ is Nothing then set no Adjustment
-- widget.
--
treeViewSetHadjustment :: TreeViewClass tv => (Maybe Adjustment) -> tv -> IO ()
treeViewSetHadjustment adj tv = {#call tree_view_set_hadjustment#} 
  (toTreeView tv) (fromMaybe (mkAdjustment nullForeignPtr) adj)

-- | Get the 'Adjustment' that
-- represents the vertical aspect.
--
treeViewGetVadjustment :: TreeViewClass tv => tv -> IO (Maybe Adjustment)
treeViewGetVadjustment tv = do
  adjPtr <- {#call unsafe tree_view_get_vadjustment#} (toTreeView tv)
  if adjPtr==nullPtr then return Nothing else do
    liftM Just $ makeNewObject mkAdjustment (return adjPtr)

-- | Set the 'Adjustment' that controls
-- the vertical aspect. If @adj@ is @Nothing@ then set no
-- 'Adjustment' widget.
--
treeViewSetVadjustment :: TreeViewClass tv => (Maybe Adjustment) -> tv -> IO ()
treeViewSetVadjustment adj tv = {#call tree_view_set_vadjustment#} 
  (toTreeView tv) (fromMaybe (mkAdjustment nullForeignPtr) adj)

-- | Query if the column headers are visible.
--
treeViewGetHeadersVisible :: TreeViewClass tv => tv -> IO Bool
treeViewGetHeadersVisible tv = liftM toBool $
  {#call unsafe tree_view_get_headers_visible#} (toTreeView tv)

-- | Set the visibility state of the column
-- headers.
--
treeViewSetHeadersVisible :: TreeViewClass tv => tv -> Bool -> IO ()
treeViewSetHeadersVisible tv vis = {#call tree_view_set_headers_visible#}
  (toTreeView tv) (fromBool vis)

-- | Resize the columns to their optimal size.
--
treeViewColumnsAutosize :: TreeViewClass tv => tv -> IO ()
treeViewColumnsAutosize tv =
  {#call tree_view_columns_autosize#} (toTreeView tv)

-- | Set wether the columns headers are
-- sensitive to mouse clicks.
--
treeViewSetHeadersClickable :: TreeViewClass tv => tv -> Bool -> IO ()
treeViewSetHeadersClickable tv click = {#call tree_view_set_headers_clickable#}
  (toTreeView tv) (fromBool click)

-- | Give visual aid for wide columns.
--
-- * This function tells GTK+ that the user interface for your
--   application requires users to read across tree columns. By default,
--   GTK+ will then render the tree with alternating row colors. Do not use
--   it just because you prefer the appearance of the ruled tree; that's a
--   question for the theme. Some themes will draw tree rows in alternating
--   colors even when rules are turned off, and users who prefer that
--   appearance all the time can choose those themes. You should call this
--   function only as a semantic hint to the theme engine that your tree
--   makes alternating colors useful from a functional standpoint (since it
--   has lots of columns, generally).
--
treeViewGetRulesHint :: TreeViewClass tv => tv -> IO Bool
treeViewGetRulesHint tv = liftM toBool $
  {#call unsafe tree_view_get_rules_hint#} (toTreeView tv)

-- | Query if visual aid for wide columns is
-- turned on.
--
treeViewSetRulesHint :: TreeViewClass tv => tv -> Bool -> IO ()
treeViewSetRulesHint tv vis = {#call tree_view_set_rules_hint#}
  (toTreeView tv) (fromBool vis)

-- | Append a new column to the 'TreeView'. Returns
-- the new number of columns.
--
treeViewAppendColumn :: TreeViewClass tv => tv -> TreeViewColumn -> IO Int
treeViewAppendColumn tv tvc = liftM fromIntegral $
  {#call tree_view_append_column#} (toTreeView tv) tvc

-- | Remove column @tvc@ from the 'TreeView'
-- widget. The number of remaining columns is returned.
--
treeViewRemoveColumn :: TreeViewClass tv => tv -> TreeViewColumn -> IO Int
treeViewRemoveColumn tv tvc = liftM fromIntegral $
  {#call tree_view_remove_column#} (toTreeView tv) tvc

-- | Inserts column @tvc@ into the
-- 'TreeView' widget at the position @pos@. Returns the number of
-- columns after insertion. Specify -1 for @pos@ to insert the column
-- at the end.
--
treeViewInsertColumn :: TreeViewClass tv => tv -> TreeViewColumn -> Int ->
                        IO Int
treeViewInsertColumn tv tvc pos = liftM fromIntegral $ 
  {#call tree_view_insert_column#} (toTreeView tv) tvc (fromIntegral pos)


-- | Insert new
-- 'TreeViewColumn'.
--
-- * Inserts new column into the
-- 'TreeView' @tv@ at position @pos@ with title
-- ref argtitle, cell renderer @cr@ and attributes
-- @attribs@. Specify -1 for @pos@ to insert the column at
-- the end.
--
treeViewInsertColumnWithAttributes :: (TreeViewClass tv, CellRendererClass cr)
   => tv -> Int -> String -> cr -> [(String,Int)] -> IO ()
treeViewInsertColumnWithAttributes tv pos title cr attribs = 
    do
    column <- treeViewColumnNew
    treeViewColumnSetTitle column title
    treeViewColumnPackStart column cr True
    treeViewColumnAddAttributes column cr attribs
    treeViewInsertColumn tv column pos
    return ()

-- | Retrieve a 'TreeViewColumn'.
--
-- * Retrieve the @pos@ th columns of
--   'TreeView'. If the index is out of range Nothing is returned.
--
treeViewGetColumn :: TreeViewClass tv => tv -> Int -> IO (Maybe TreeViewColumn)
treeViewGetColumn tv pos = do
  tvcPtr <- {#call unsafe tree_view_get_column#} (toTreeView tv) 
    (fromIntegral pos)
  if tvcPtr==nullPtr then return Nothing else 
    liftM Just $ makeNewObject mkTreeViewColumn (return tvcPtr)


-- | Return all 'TreeViewColumn's in this
-- 'TreeView'.
--
treeViewGetColumns :: TreeViewClass tv => tv -> IO [TreeViewColumn]
treeViewGetColumns tv = do
  colsList <- {#call unsafe tree_view_get_columns#} (toTreeView tv)
  colsPtr <- fromGList colsList
  mapM (makeNewObject mkTreeViewColumn) (map return colsPtr)

-- | Move a specific column.
--
-- * Use 'treeViewMoveColumnToFront' if you want to move the column
--   to the left end of the 'TreeView'.
--
treeViewMoveColumnAfter :: TreeViewClass tv => tv -> TreeViewColumn ->
					       TreeViewColumn -> IO ()
treeViewMoveColumnAfter tv which after = {#call tree_view_move_column_after#}
  (toTreeView tv) which after

-- | Move a specific column.
--
-- * Use 'treeViewMoveColumnAfter' if you want to move the column
--   somewhere else than to the leftmost position.
--
treeViewMoveColumnFirst :: TreeViewClass tv => tv -> TreeViewColumn -> IO ()
treeViewMoveColumnFirst tv which = {#call tree_view_move_column_after#}
  (toTreeView tv) which (mkTreeViewColumn nullForeignPtr)

-- | Set location of hierarchy controls.
--
-- * Sets the column to draw the expander arrow at. If @col@
--   is @Nothing@, then the expander arrow is always at the first
--   visible column.
--
treeViewSetExpanderColumn :: TreeViewClass tv => tv -> Maybe TreeViewColumn ->
						 IO ()
treeViewSetExpanderColumn tv (Just tvc) =
  {#call unsafe tree_view_set_expander_column#} (toTreeView tv) tvc
treeViewSetExpanderColumn tv Nothing =
  {#call unsafe tree_view_set_expander_column#} (toTreeView tv)
    (mkTreeViewColumn nullForeignPtr)

-- | Get location of hierarchy controls.
--
-- * Gets the column to draw the expander arrow at. If @col@
--   is @Nothing@, then the expander arrow is always at the first
--   visible column.
--
treeViewGetExpanderColumn :: TreeViewClass tv => tv -> IO TreeViewColumn
treeViewGetExpanderColumn tv = makeNewObject mkTreeViewColumn $
  {#call unsafe tree_view_get_expander_column#} (toTreeView tv)

-- | Specify where a column may be
-- dropped.
--
-- * Sets a user function for determining where a column may be dropped when
--   dragged.  This function is called on every column pair in turn at the
--   beginning of a column drag to determine where a drop can take place.
-- * The callback function take the 'TreeViewColumn' to be moved, the
--   second and third arguments are the columns on the left and right side
--   of the new location. At most one of them might be @Nothing@
--   which indicates that the column is about to be dropped at the left or
--   right end of the 'TreeView'.
-- * The predicate @pred@ should return @True@ if it is ok
--   to insert the column at this place.
-- * Use @Nothing@ for the predicate if columns can be inserted
--   anywhere.
--
treeViewSetColumnDragFunction :: TreeViewClass tv => tv -> 
				 Maybe (TreeViewColumn ->
				        Maybe TreeViewColumn ->
					Maybe TreeViewColumn -> IO Bool) ->
				 IO ()
treeViewSetColumnDragFunction tv Nothing =
  {#call tree_view_set_column_drag_function#} (toTreeView tv)
    nullFunPtr nullPtr nullFunPtr
treeViewSetColumnDragFunction tv (Just pred) = do
  fPtr <- mkTreeViewColumnDropFunc $ \_ target prev next _ -> do
    target' <- makeNewObject mkTreeViewColumn (return target)
    prev' <- if prev==nullPtr then return Nothing else liftM Just $
      makeNewObject mkTreeViewColumn (return prev)
    next' <- if next==nullPtr then return Nothing else liftM Just $
      makeNewObject mkTreeViewColumn (return next)
    res <- pred target' prev' next'
    return (fromBool res)
  {#call tree_view_set_column_drag_function#} (toTreeView tv) fPtr 
    nullPtr nullFunPtr
  freeHaskellFunPtr fPtr

{#pointer TreeViewColumnDropFunc#}

foreign import ccall "wrapper" mkTreeViewColumnDropFunc ::
  (Ptr () -> Ptr TreeViewColumn -> Ptr TreeViewColumn -> Ptr TreeViewColumn ->
  Ptr () -> IO {#type gboolean#}) -> IO TreeViewColumnDropFunc

-- | Scroll to a coordinate.
--

-- * Scrolls the tree view such that the top-left corner of the
--   visible area is @treeX@, @treeY@, where @treeX@
--   and @treeY@ are specified in tree window coordinates.
--   The 'TreeView' must be realized before this function is
--   called.  If it isn't, you probably want to use
--   'treeViewScrollToCell'.
--
treeViewScrollToPoint :: TreeViewClass tv => tv -> Int -> Int -> IO ()
treeViewScrollToPoint tv treeX treeY = 
  {#call tree_view_scroll_to_point#} (toTreeView tv)
    (fromIntegral treeX) (fromIntegral treeY)

-- | Scroll to a cell.
--
-- * Scroll to a cell as specified by @path@ and @tvc@. 
--   The cell is aligned within the 'TreeView' widget as
--   follows: horizontally by @hor@ from left (@0.0@) to
--   right (@1.0@) and vertically by @ver@ from top
--   (@0.0@) to buttom (@1.0@).
--
treeViewScrollToCell :: TreeViewClass tv => tv -> TreePath -> TreeViewColumn ->
                        Maybe (Float,Float) -> IO ()
treeViewScrollToCell tv path tvc (Just (ver,hor)) = 
  {#call tree_view_scroll_to_cell#} 
  (toTreeView tv) path tvc 1 (realToFrac ver) (realToFrac hor)
treeViewScrollToCell tv path tvc Nothing = 
  {#call tree_view_scroll_to_cell#} 
  (toTreeView tv) path tvc 0 0.0 0.0


-- | Selects a specific row.
--
-- * Sets the current keyboard focus to be at @path@, and
--   selects it.  This is useful when you want to focus the user's
--   attention on a particular row.  If @focusColumn@ is given,
--   then the input focus is given to the column specified by
--   it. Additionally, if @focusColumn@ is specified, and 
--   @startEditing@ is @True@,
--   then editing will be started in the
--   specified cell.  This function is often followed by a
--   'widgetGrabFocus' to the 'TreeView' in order
--   to give keyboard focus to the widget.
--
treeViewSetCursor :: TreeViewClass tv => tv -> TreePath ->
					 (Maybe (TreeViewColumn, Bool)) ->
					 IO ()
treeViewSetCursor tv tp Nothing =
  {#call tree_view_set_cursor#} (toTreeView tv) tp
    (mkTreeViewColumn nullForeignPtr) (fromBool False)
treeViewSetCursor tv tp (Just (focusColumn, startEditing)) =
  {#call tree_view_set_cursor#} (toTreeView tv) tp
    focusColumn (fromBool startEditing)

#if GTK_CHECK_VERSION(2,2,0)
-- | Selects a cell in a specific row.
--
-- * Similar to 'treeViewSetCursor' but allows a column to
--   containt several 'CellRenderer's.
--
-- * Only available in Gtk 2.2 and higher.
--
treeViewSetCursorOnCell :: TreeViewClass tv => tv -> TreePath ->
					 TreeViewColumn ->
					 CellRenderer ->
					 Bool -> IO ()
treeViewSetCursorOnCell tv tp focusColumn focusCell startEditing =
  {#call tree_view_set_cursor_on_cell#} (toTreeView tv) tp
    focusColumn focusCell (fromBool startEditing)
#endif

-- | Retrieves the position of the focus.
--
-- * Returns a pair @(path, column)@.If the cursor is not currently
--   set, @path@ will be @Nothing@. If no column is currently
--   selected, @column@ will be @Nothing@.
--
treeViewGetCursor :: TreeViewClass tv => tv -> 
		     IO (Maybe TreePath, Maybe TreeViewColumn)
treeViewGetCursor tv = alloca $ \tpPtrPtr -> alloca $ \tvcPtrPtr -> do
  {#call unsafe tree_view_get_cursor#} (toTreeView tv)
    (castPtr tpPtrPtr) (castPtr tvcPtrPtr)
  tpPtr <- peek tpPtrPtr
  tvcPtr <- peek tvcPtrPtr
  tp <- if tpPtr==nullPtr then return Nothing else liftM (Just . TreePath) $ 
    newForeignPtr tpPtr (tree_path_free tpPtr)
  tvc <- if tvcPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkTreeViewColumn (return tvcPtr)
  return (tp,tvc)

-- | Emit the activated signal on a cell.
--
treeViewRowActivated :: TreeViewClass tv => tv -> TreePath -> 
					    TreeViewColumn -> IO ()
treeViewRowActivated tv tp tvc = 
  {#call tree_view_row_activated#} (toTreeView tv) tp tvc

-- | Expand all nodes in the 'TreeView'.
--
treeViewExpandAll :: TreeViewClass tv => tv -> IO ()
treeViewExpandAll tv = {#call tree_view_expand_all#} (toTreeView tv)

-- | Collapse all nodes in the 'TreeView'.
--
treeViewCollapseAll :: TreeViewClass tv => tv -> IO ()
treeViewCollapseAll tv =
  {#call tree_view_collapse_all#} (toTreeView tv)

#if GTK_CHECK_VERSION(2,2,0)
-- | Make a certain path visible.
--
-- * This will expand all parent rows of @tp@ as necessary.
--
-- * Only available in Gtk 2.2 and higher.
--
treeViewExpandToPath :: TreeViewClass tv => tv -> TreePath -> IO ()
treeViewExpandToPath tv tp =
  {#call tree_view_expand_to_path#} (toTreeView tv) tp
#endif

-- | Expand a row.
--
-- * Expand a node that is specified by 
-- @path@. If the @all@ is @True@ every
-- child will be expanded recursively. Returns @True@ if the row 
-- existed and had children.
--
treeViewExpandRow :: TreeViewClass tv => TreePath -> Bool -> tv -> IO Bool
treeViewExpandRow path all tv = liftM toBool $
  {#call tree_view_expand_row#} (toTreeView tv) path (fromBool all)

-- | Collapse a row. Returns @True@ if the
-- row existed.
--
treeViewCollapseRow :: TreeViewClass tv => tv -> TreePath -> IO Bool
treeViewCollapseRow tv path = liftM toBool $
  {#call tree_view_collapse_row#} (toTreeView tv) path

-- | Call function for every expaned row.
--
treeViewMapExpandedRows :: TreeViewClass tv => tv -> (TreePath -> IO ()) ->
					       IO ()
treeViewMapExpandedRows tv func = do
  fPtr <- mkTreeViewMappingFunc $ \_ tpPtr _ -> do
    tp <- liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr)
    func tp
  {#call tree_view_map_expanded_rows#} (toTreeView tv) fPtr nullPtr
  freeHaskellFunPtr fPtr

{#pointer TreeViewMappingFunc#}

foreign import ccall "wrapper" mkTreeViewMappingFunc ::
  (Ptr TreeView -> Ptr TreePath -> Ptr () -> IO ()) ->
  IO TreeViewMappingFunc

-- | Check if row is expanded.
--
treeViewRowExpanded :: TreeViewClass tv => tv -> TreePath -> IO Bool
treeViewRowExpanded tv tp = liftM toBool $
  {#call unsafe tree_view_row_expanded#} (toTreeView tv) tp

-- | Query if rows can be moved around.
--
-- * See 'treeViewSetReorderable'.
--
treeViewGetReorderable :: TreeViewClass tv => tv -> IO Bool
treeViewGetReorderable tv = liftM toBool $
  {#call unsafe tree_view_get_reorderable#} (toTreeView tv)

-- | Check if rows can be moved around.
--
-- * Set whether the user can use drag and drop (DND) to reorder the
--   rows in the store. This works on both 'TreeStore' and
--   'ListStore' models. If @ro@ is @True@, then the
--   user can reorder the model by dragging and dropping rows.  The
--   developer can listen to these changes by connecting to the model's
--   signals.  This function does not give you any degree of control over
--   the order -- any reorderering is allowed.  If more control is needed,
--   you should probably handle drag and drop manually.
--
treeViewSetReorderable :: TreeViewClass tv => tv -> Bool -> IO ()
treeViewSetReorderable tv ro = {#call tree_view_set_reorderable#}
  (toTreeView tv) (fromBool ro)

-- | Map a pixel to the specific cell.
--
-- * Finds the path at the 'Point' @(x, y)@. The
--   coordinates @x@ and @y@ are relative to the top left
--   corner of the 'TreeView' drawing window. As such, coordinates
--   in a mouse click event can be used directly to determine the cell
--   which the user clicked on. This is therefore a way to realize for
--   popup menus.
--
-- * The returned point is the input point relative to the cell's upper
--   left corner. The whole 'TreeView' is divided between all cells.
--   The returned point is relative to the rectangle this cell occupies
--   within the 'TreeView'.
--
treeViewGetPathAtPos :: TreeViewClass tv => tv -> Point ->
			IO (Maybe (TreePath, TreeViewColumn, Point))
treeViewGetPathAtPos tv (x,y) = alloca $ \tpPtrPtr -> alloca $ \tvcPtrPtr ->
  alloca $ \xPtr -> alloca $ \yPtr -> do
    res <- liftM toBool $ {#call unsafe tree_view_get_path_at_pos#}
      (toTreeView tv) (fromIntegral x) (fromIntegral y) (castPtr tpPtrPtr)
      (castPtr tvcPtrPtr) xPtr yPtr
    tpPtr <- peek tpPtrPtr
    tvcPtr <- peek tvcPtrPtr
    xCell <- peek xPtr
    yCell <- peek yPtr
    if not res then return Nothing else do
      tp <- liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr)
      tvc <- makeNewObject mkTreeViewColumn (return tvcPtr)
      return (Just (tp,tvc,(fromIntegral xCell, fromIntegral yCell)))

-- | Retrieve the smallest bounding box of a cell.
--
-- * Fills the bounding rectangle in tree window coordinates for the
--   cell at the row specified by @tp@ and the column specified by
--   @tvc@.
--   If @path@ is @Nothing@ or points to a path not
--   currently displayed, the @y@ and @height@ fields of
--   the 'Rectangle' will be filled with @0@. The sum of
--   all cell rectangles does not cover the entire tree; there are extra
--   pixels in between rows, for example.
--
treeViewGetCellArea :: TreeViewClass tv => tv -> Maybe TreePath -> 
					   TreeViewColumn -> IO Rectangle
treeViewGetCellArea tv Nothing tvc = alloca $ \rPtr ->
  {#call unsafe tree_view_get_cell_area#} (toTreeView tv)
    (TreePath nullForeignPtr) tvc (castPtr (rPtr :: Ptr Rectangle))
    >> peek rPtr
treeViewGetCellArea tv (Just tp) tvc = alloca $ \rPtr -> do
  {#call unsafe tree_view_get_cell_area#} (toTreeView tv) tp
    tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr

-- | Retrieve the largest bounding box 
-- of a cell.
--
-- * Fills the bounding rectangle in tree window coordinates for the
--   cell at the row specified by @tp@ and the column specified by
--   @tvc@.
--   If @path@ is @Nothing@ or points to a path not
--   currently displayed, the @y@ and @height@ fields of
--   the 'Rectangle' will be filled with @0@. The background
--   areas tile the widget's area to cover the entire tree window 
--   (except for the area used for header buttons). Contrast this with
--   'treeViewGetCellArea'.
--
treeViewGetBackgroundArea :: TreeViewClass tv => tv -> Maybe TreePath -> 
					   TreeViewColumn -> IO Rectangle
treeViewGetBackgroundArea tv Nothing tvc = alloca $ \rPtr ->
  {#call unsafe tree_view_get_background_area#} (toTreeView tv)
    (TreePath nullForeignPtr) tvc (castPtr (rPtr :: Ptr Rectangle))
    >> peek rPtr
treeViewGetBackgroundArea tv (Just tp) tvc = alloca $ \rPtr -> do
  {#call unsafe tree_view_get_background_area#} (toTreeView tv) tp
    tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr

-- | Retrieve the currently visible area.
--
-- * The returned rectangle gives the visible part of the tree in tree
--   coordinates.
--
treeViewGetVisibleRect :: TreeViewClass tv => tv -> IO Rectangle
treeViewGetVisibleRect tv = alloca $ \rPtr -> do
  {#call unsafe tree_view_get_visible_rect#} (toTreeView tv)
    (castPtr (rPtr :: Ptr Rectangle))
  peek rPtr

-- | Convert widget to tree pixel coordinates.
--
-- * See module description.
--
treeViewWidgetToTreeCoords :: TreeViewClass tv => tv -> Point -> IO Point
treeViewWidgetToTreeCoords tv (x,y) = alloca $ \xPtr -> alloca $ \yPtr -> do
  {#call unsafe tree_view_tree_to_widget_coords#} (toTreeView tv)
    (fromIntegral x) (fromIntegral y) xPtr yPtr
  x' <- peek xPtr
  y' <- peek yPtr
  return (fromIntegral x', fromIntegral y')

-- | Convert tree to widget pixel coordinates.
--
-- * See module description.
--
treeViewTreeToWidgetCoords :: TreeViewClass tv => tv -> Point -> IO Point
treeViewTreeToWidgetCoords tv (x,y) = alloca $ \xPtr -> alloca $ \yPtr -> do
  {#call unsafe tree_view_widget_to_tree_coords#} (toTreeView tv)
    (fromIntegral x) (fromIntegral y) xPtr yPtr
  x' <- peek xPtr
  y' <- peek yPtr
  return (fromIntegral x', fromIntegral y')

-- | Creates a "Pixmap" representation of the row at the given path. This image
-- can be used for a drag icon.
--
treeViewCreateRowDragIcon :: TreeViewClass tv => tv -> TreePath -> IO Pixmap
treeViewCreateRowDragIcon tv path =
  makeNewGObject mkPixmap $
  {#call unsafe tree_view_create_row_drag_icon#} (toTreeView tv) path

-- | Set if user can search entries.
--
-- * If enabled, the user can type in text which will set the cursor to
--   the first matching entry.
--
treeViewGetEnableSearch :: TreeViewClass tv => tv -> IO Bool
treeViewGetEnableSearch tv = liftM toBool $
  {#call unsafe tree_view_get_enable_search#} (toTreeView tv)

-- | Check if user can search entries.
--
treeViewSetEnableSearch :: TreeViewClass tv => tv -> Bool -> IO ()
treeViewSetEnableSearch tv es = {#call tree_view_set_enable_search#}
  (toTreeView tv) (fromBool es)

-- | Gets the column searched on by the interactive search.
--
treeViewGetSearchColumn :: TreeViewClass tv => tv -> IO Int
treeViewGetSearchColumn tv = liftM fromIntegral $
  {#call unsafe tree_view_get_search_column#} (toTreeView tv)

-- | Set the column searched on by by the interactive search.
--
-- * Additionally, turns on interactive searching.
--
treeViewSetSearchColumn :: TreeViewClass tv => tv -> Int -> IO ()
treeViewSetSearchColumn tv sc = {#call tree_view_set_search_column#}
  (toTreeView tv) (fromIntegral sc)

-- | Set the predicate to test for equality.
--
-- * The default function assumes that the column @col@ has contains
--   'Attribute' @cr@ @String@. It conducts a
--   case insensitive comparison of the text typed by the user and the
--   text in the tree model. This function can be used to override this 
--   behaviour. The predicate returns @True@ if the entries should
--   be considered to match. The parameters are the column number, the text
--   the user typed in and a 'TreeIter' which points to the cell
--   to be compared.
--
treeViewSetSearchEqualFunc :: TreeViewClass tv => tv ->
			      (Int -> String -> TreeIter -> IO Bool) ->
			      IO ()
treeViewSetSearchEqualFunc tv pred = do
  fPtr <- mkTreeViewSearchEqualFunc (\_ col keyPtr itPtr _ -> do
    key <- peekUTFString keyPtr
    iter <- createTreeIter itPtr
    liftM fromBool $ pred (fromIntegral col) key iter)
  dRef <- newIORef nullFunPtr
  dPtr <- mkDestructor $ do
    dPtr <- readIORef dRef
    freeHaskellFunPtr dPtr
    freeHaskellFunPtr fPtr
  writeIORef dRef dPtr
  {#call tree_view_set_search_equal_func#} (toTreeView tv) fPtr 
    nullPtr dPtr

{#pointer TreeViewSearchEqualFunc#}

foreign import ccall "wrapper" mkTreeViewSearchEqualFunc ::
  (Ptr TreeModel -> {#type gint#} -> CString -> Ptr TreeIter -> Ptr () ->
   IO {#type gboolean#}) -> IO TreeViewSearchEqualFunc

-- | The user has dragged a column to another
-- position.
--
onColumnsChanged, afterColumnsChanged :: TreeViewClass tv => tv -> IO () ->
					 IO (ConnectId tv)
onColumnsChanged = connect_NONE__NONE "columns_changed" False
afterColumnsChanged = connect_NONE__NONE "columns_changed" True

-- | The cursor in the tree has moved.
--
onCursorChanged, afterCursorChanged :: TreeViewClass tv => tv -> IO () ->
				       IO (ConnectId tv)
onCursorChanged = connect_NONE__NONE "cursor_changed" False
afterCursorChanged = connect_NONE__NONE "cursor_changed" True

-- | A row was activated.
--
-- * Activation usually means the user has pressed return on a row.
--
onRowActivated, afterRowActivated :: TreeViewClass tv => tv ->
				     (TreePath -> TreeViewColumn -> IO ()) ->
				     IO (ConnectId tv)
onRowActivated = connect_BOXED_OBJECT__NONE "row_activated" 
		   createTreePath False
afterRowActivated = connect_BOXED_OBJECT__NONE "row_activated" 
		      createTreePath True

-- | Children of this node were hidden.
--
onRowCollapsed, afterRowCollapsed :: TreeViewClass tv => tv ->
				     (TreeIter -> TreePath -> IO ()) ->
				     IO (ConnectId tv)
onRowCollapsed = connect_BOXED_BOXED__NONE "row_collapsed"
		   createTreeIter createTreePath False
afterRowCollapsed = connect_BOXED_BOXED__NONE "row_collapsed"
		      createTreeIter createTreePath True

-- | Children of this node are made visible.
--
onRowExpanded, afterRowExpanded :: TreeViewClass tv => tv ->
				     (TreeIter -> TreePath -> IO ()) ->
				     IO (ConnectId tv)
onRowExpanded = connect_BOXED_BOXED__NONE "row_expanded"
		   createTreeIter createTreePath False
afterRowExpanded = connect_BOXED_BOXED__NONE "row_expanded"
		      createTreeIter createTreePath True

-- | The user wants to search 
-- interactively.
--
-- * Connect to this signal if you want to provide you own search facility.
--   Note that you must handle all keyboard input yourself.
--
onStartInteractiveSearch, afterStartInteractiveSearch :: 
  TreeViewClass tv => tv -> IO () -> IO (ConnectId tv)

#if GTK_CHECK_VERSION(2,2,0)

onStartInteractiveSearch tv fun =
  connect_NONE__BOOL "start_interactive_search" False tv (fun >> return True)
afterStartInteractiveSearch tv fun =
  connect_NONE__BOOL "start_interactive_search" True tv (fun >> return True)

#else

onStartInteractiveSearch =
  connect_NONE__NONE "start_interactive_search" False
afterStartInteractiveSearch = 
  connect_NONE__NONE "start_interactive_search" True

#endif

-- | Determine if this row should be collapsed.
--
-- * If the application connects to this function and returns @False@,
--   the specifc row will not be altered.
--
onTestCollapseRow, afterTestCollapseRow :: TreeViewClass tv => tv ->
					   (TreeIter -> TreePath -> IO Bool) ->
					   IO (ConnectId tv)
onTestCollapseRow = connect_BOXED_BOXED__BOOL "test_collapse_row"
		   createTreeIter createTreePath False
afterTestCollapseRow = connect_BOXED_BOXED__BOOL "test_collapse_row"
		      createTreeIter createTreePath True

-- | Determine if this row should be expanded.
--
-- * If the application connects to this function and returns @False@,
--   the specifc row will not be altered.
--
onTestExpandRow, afterTestExpandRow :: TreeViewClass tv => tv ->
					   (TreeIter -> TreePath -> IO Bool) ->
					   IO (ConnectId tv)
onTestExpandRow = connect_BOXED_BOXED__BOOL "test_expand_row"
		   createTreeIter createTreePath False
afterTestExpandRow = connect_BOXED_BOXED__BOOL "test_expand_row"
		      createTreeIter createTreePath True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Selectors FileChooser.chs.pp,NONE,1.1 FileChooserDialog.chs.pp,NONE,1.1 FileChooserWidget.chs.pp,NONE,1.1

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

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

Added Files:
	FileChooser.chs.pp FileChooserDialog.chs.pp 
	FileChooserWidget.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: FileChooserDialog.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget FileChooserDialog
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- The file chooser dialog and widget is a replacement
-- for the old "FileSel"ection dialog. It provides a better user
-- interface and an improved API.
--
-- * This is the dialog variant of the "FileChooser"
--
-- * Added in GTK+ 2.4
--
module Graphics.UI.Gtk.Selectors.FileChooserDialog  (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserDialogClass,
  FileChooserDialog,
  fileChooserDialogNew,
  fileChooserDialogNewWithBackend
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM, when)
import Maybe (isJust, fromJust)

import System.Glib.FFI
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Selectors.FileChooser#}
import System.Glib.GObject (objectNew)
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Windows.Window
import Graphics.UI.Gtk.Windows.Dialog
import System.Glib.GValue
import System.Glib.StoreValue

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

-- The FileChooserDialog implements the FileChooser interface
-- which we model in Haskell as another instance decleration
instance FileChooserClass FileChooserDialog

fileChooserDialogNew
  :: Maybe String            -- ^ Title of the dialog (or default)
  -> Maybe Window            -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction       -- ^ Open or save mode for the dialog
  -> [(String, ResponseId)]  -- ^ Buttons and their response codes
  -> IO FileChooserDialog
fileChooserDialogNew title parent action buttons =
  internalFileChooserDialogNew title parent action buttons Nothing


fileChooserDialogNewWithBackend
  :: Maybe String              -- ^ Title of the dialog (or default)
  -> Maybe Window              -- ^ Transient parent of the dialog (or none)
  -> FileChooserAction         -- ^ Open or save mode for the dialog
  -> [(String, ResponseId)]    -- ^ Buttons and their response codes
  -> String                    -- ^ The name of the filesystem backend to use
  -> IO FileChooserDialog
fileChooserDialogNewWithBackend title parent action buttons backend =
  internalFileChooserDialogNew title parent action buttons (Just backend)
  

-- Annoyingly, the constructor for FileChooserDialog uses varargs so we can't
-- call it using the Haskell FFI. The GTK people do not consider this an api
-- bug, see <http://bugzilla.gnome.org/show_bug.cgi?id=141004>
-- The solution is to call objectNew and add the buttons manually.

internalFileChooserDialogNew ::
  Maybe String ->           -- Title of the dialog (or default)
  Maybe Window ->           -- Transient parent of the dialog (or none)
  FileChooserAction ->      -- Open or save mode for the dialog
  [(String, ResponseId)] -> -- Buttons and their response codes
  Maybe String ->           -- The name of the backend to use (optional)
  IO FileChooserDialog
internalFileChooserDialogNew title parent action buttons backend = do
  objType <- {# call unsafe gtk_file_chooser_dialog_get_type #}
  dialog <-makeNewObject mkFileChooserDialog $ liftM castPtr $
           if (isJust backend)
             then with (GVstring backend) $ \backendGValue ->
                  objectNew objType [("file-system-backend", backendGValue)]
             else objectNew objType []
  when (isJust title)
       (dialog `windowSetTitle` fromJust title)
  when (isJust parent)
       (dialog `windowSetTransientFor` fromJust parent)
  dialog `fileChooserSetAction` action
  mapM_ (\(btnName, btnResponse) ->
          dialogAddButton dialog btnName btnResponse) buttons
  return dialog

#endif

--- NEW FILE: FileChooser.chs.pp ---
-- GIMP Toolkit (GTK) Binding for Haskell: binding to GConf   -*-haskell-*-
--    for storing and retrieving configuartion information
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  The file chooser dialog and widget is a replacement
--  for the old "FileSel"ection dialog. It provides a better user
--  interface and an improved API.
--
--  The FileChooser (as opposed to the dialog or widget) is the interface that
--  the "FileChooserDialog" and "FileChooserWidget" implement, all the operations
--  except construction are on this interface.
--
-- * Added in GTK+ 2.4
--
module Graphics.UI.Gtk.Selectors.FileChooser  (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserClass,
  FileChooser,
  FileChooserAction(..),
  fileChooserSetAction,
  fileChooserGetAction,
  fileChooserSetLocalOnly,
  fileChooserGetLocalOnly,
  fileChooserSetSelectMultiple,
  fileChooserGetSelectMultiple,
  fileChooserSetCurrentName,
  fileChooserGetFilename,
  fileChooserSetFilename,
  fileChooserSelectFilename,
  fileChooserUnselectFilename,
  fileChooserSelectAll,
  fileChooserUnselectAll,
  fileChooserGetFilenames,
  fileChooserSetCurrentFolder,
  fileChooserGetCurrentFolder,
  fileChooserGetURI,
  fileChooserSetURI,
  fileChooserSelectURI,
  fileChooserUnselectURI,
  fileChooserGetURIs,
  fileChooserSetCurrentFolderURI,
  fileChooserGetCurrentFolderURI,
  fileChooserSetPreviewWidget,
  fileChooserGetPreviewWidget,
  fileChooserSetPreviewWidgetActive,
  fileChooserGetPreviewWidgetActive,
  fileChooserSetUsePreviewLabel,
  fileChooserGetUsePreviewLabel,
  fileChooserGetPreviewFilename,
  fileChooserGetPreviewURI,
  fileChooserSetExtraWidget,
  fileChooserGetExtraWidget,
  fileChooserAddFilter,
  fileChooserRemoveFilter,
  fileChooserListFilters,
  fileChooserSetFilter,
  fileChooserGetFilter,
  fileChooserAddShortcutFolder,
  fileChooserRemoveShortcutFolder,
  fileChooserlistShortcutFolders,
  fileChooserAddShortcutFolderURI,
  fileChooserRemoveShortcutFolderURI,
  fileChooserListShortcutFolderURIs,
  onCurrentFolderChanged,
  afterCurrentFolderChanged,
  onFileActivated,
  afterFileActivated,
--  onSelectionChanged,
--  afterSelectionChanged,
  onUpdatePreview,
  afterUpdatePreview
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM, when)

import System.Glib.FFI
import System.Glib.UTFString		(readCString)
{#import Graphics.UI.Gtk.Types#}
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import Graphics.UI.Gtk.Signals
{#import System.Glib.GList#}
import System.Glib.GError		(propagateGError, GErrorDomain, GErrorClass(..))

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

{# enum FileChooserAction {underscoreToCase} #}
{# enum FileChooserError {underscoreToCase} #}

fileChooserErrorDomain :: GErrorDomain
fileChooserErrorDomain = unsafePerformIO {#call unsafe file_chooser_error_quark#}
                                                                                                         
instance GErrorClass FileChooserError where
  gerrorDomain _ = fileChooserErrorDomain

fileChooserSetAction :: FileChooserClass chooser => chooser -> FileChooserAction -> IO ()
fileChooserSetAction chooser action =
  {# call gtk_file_chooser_set_action #} (toFileChooser chooser)
    (fromIntegral $ fromEnum action)

fileChooserGetAction :: FileChooserClass chooser => chooser ->  IO FileChooserAction
fileChooserGetAction chooser = liftM (toEnum . fromIntegral) $
  {# call gtk_file_chooser_get_action #} (toFileChooser chooser)

fileChooserSetLocalOnly :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetLocalOnly chooser localOnly = 
  {# call gtk_file_chooser_set_local_only #} (toFileChooser chooser)
    (fromBool localOnly)

fileChooserGetLocalOnly :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetLocalOnly chooser = liftM toBool $
  {# call gtk_file_chooser_get_local_only #} (toFileChooser chooser)

fileChooserSetSelectMultiple :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetSelectMultiple chooser selectMultiple = 
  {# call gtk_file_chooser_set_select_multiple #} (toFileChooser chooser)
    (fromBool selectMultiple)

fileChooserGetSelectMultiple :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetSelectMultiple chooser = liftM toBool $
  {# call gtk_file_chooser_get_select_multiple #} (toFileChooser chooser)

fileChooserSetCurrentName :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserSetCurrentName chooser name =
  withCString name $ \strPtr ->
  {# call gtk_file_chooser_set_current_name #} (toFileChooser chooser) strPtr

fileChooserGetFilename :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetFilename chooser = do
  strPtr <- {# call gtk_file_chooser_get_filename #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetFilename :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetFilename chooser filename = liftM toBool $
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_set_filename #} (toFileChooser chooser) strPtr

fileChooserSelectFilename :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSelectFilename chooser filename = liftM toBool $
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_select_filename #} (toFileChooser chooser) strPtr

fileChooserUnselectFilename :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserUnselectFilename chooser filename = 
  withCString filename $ \strPtr ->
  {# call gtk_file_chooser_unselect_filename #} (toFileChooser chooser) strPtr

fileChooserSelectAll :: FileChooserClass chooser => chooser -> IO ()
fileChooserSelectAll chooser = 
  {# call gtk_file_chooser_select_all #} (toFileChooser chooser)

fileChooserUnselectAll :: FileChooserClass chooser => chooser -> IO ()
fileChooserUnselectAll chooser = 
  {# call gtk_file_chooser_unselect_all #} (toFileChooser chooser)

fileChooserGetFilenames :: FileChooserClass chooser => chooser -> IO [String]
fileChooserGetFilenames chooser = do
  strList <- {# call gtk_file_chooser_get_filenames #} (toFileChooser chooser)
  fromStringGSList strList

fileChooserSetCurrentFolder :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetCurrentFolder chooser foldername = liftM toBool $
  withCString foldername $ \strPtr ->
  {# call gtk_file_chooser_set_current_folder #} (toFileChooser chooser) strPtr

fileChooserGetCurrentFolder :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetCurrentFolder chooser = do
  strPtr <- {# call gtk_file_chooser_get_current_folder #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserGetURI :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_uri #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_set_uri #} (toFileChooser chooser) strPtr

fileChooserSelectURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSelectURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_select_uri #} (toFileChooser chooser) strPtr

fileChooserUnselectURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserUnselectURI chooser uri = 
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_unselect_uri #} (toFileChooser chooser) strPtr

fileChooserGetURIs :: FileChooserClass chooser => chooser -> IO [String]
fileChooserGetURIs chooser = do
  strList <- {# call gtk_file_chooser_get_uris #} (toFileChooser chooser)
  fromStringGSList strList

fileChooserSetCurrentFolderURI :: FileChooserClass chooser => chooser -> String -> IO Bool
fileChooserSetCurrentFolderURI chooser uri = liftM toBool $
  withCString uri $ \strPtr ->
  {# call gtk_file_chooser_set_current_folder_uri #} (toFileChooser chooser) strPtr

fileChooserGetCurrentFolderURI :: FileChooserClass chooser => chooser -> IO String
fileChooserGetCurrentFolderURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_current_folder_uri #} (toFileChooser chooser)
  readCString strPtr

fileChooserSetPreviewWidget :: (FileChooserClass chooser, WidgetClass widget) =>
                               chooser -> widget -> IO ()
fileChooserSetPreviewWidget chooser widget = 
  {# call gtk_file_chooser_set_preview_widget #} (toFileChooser chooser)
    (toWidget widget)

fileChooserGetPreviewWidget :: FileChooserClass chooser => chooser -> IO (Maybe Widget)
fileChooserGetPreviewWidget chooser = do
  ptr <- {# call gtk_file_chooser_get_preview_widget #} (toFileChooser chooser)
  maybePeek (makeNewObject mkWidget . return) ptr

fileChooserSetPreviewWidgetActive :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetPreviewWidgetActive chooser active = 
  {# call gtk_file_chooser_set_preview_widget_active #} (toFileChooser chooser)
    (fromBool active)

fileChooserGetPreviewWidgetActive :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetPreviewWidgetActive chooser = liftM toBool $
  {# call gtk_file_chooser_get_preview_widget_active #} (toFileChooser chooser)

fileChooserSetUsePreviewLabel :: FileChooserClass chooser => chooser -> Bool -> IO ()
fileChooserSetUsePreviewLabel chooser usePreview = 
  {# call gtk_file_chooser_set_use_preview_label #} (toFileChooser chooser)
    (fromBool usePreview)

fileChooserGetUsePreviewLabel :: FileChooserClass chooser => chooser -> IO Bool
fileChooserGetUsePreviewLabel chooser = liftM toBool $
  {# call gtk_file_chooser_get_use_preview_label #} (toFileChooser chooser)

fileChooserGetPreviewFilename :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetPreviewFilename chooser = do
  strPtr <- {# call gtk_file_chooser_get_preview_filename #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserGetPreviewURI :: FileChooserClass chooser => chooser -> IO (Maybe String)
fileChooserGetPreviewURI chooser = do
  strPtr <- {# call gtk_file_chooser_get_preview_uri #} (toFileChooser chooser)
  maybePeek readCString strPtr

fileChooserSetExtraWidget :: (FileChooserClass chooser, WidgetClass widget) =>
                             chooser -> widget -> IO ()
fileChooserSetExtraWidget chooser widget = 
  {# call gtk_file_chooser_set_extra_widget #} (toFileChooser chooser)
    (toWidget widget)

fileChooserGetExtraWidget :: FileChooserClass chooser => chooser -> IO (Maybe Widget)
fileChooserGetExtraWidget chooser = do
  ptr <- {# call gtk_file_chooser_get_extra_widget #} (toFileChooser chooser)
  maybePeek (makeNewObject mkWidget . return) ptr

fileChooserAddFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserAddFilter chooser filter = 
  {# call gtk_file_chooser_add_filter #} (toFileChooser chooser) filter

fileChooserRemoveFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserRemoveFilter chooser filter = 
  {# call gtk_file_chooser_remove_filter #} (toFileChooser chooser) filter

fileChooserListFilters :: FileChooserClass chooser => chooser -> IO [FileFilter]
fileChooserListFilters chooser = do
  filterList <- {# call gtk_file_chooser_list_filters #} (toFileChooser chooser)
  filterPtrs <- fromGSList filterList
  mapM (makeNewObject mkFileFilter . return) filterPtrs

fileChooserSetFilter :: FileChooserClass chooser => chooser -> FileFilter -> IO ()
fileChooserSetFilter chooser filter = 
  {# call gtk_file_chooser_set_filter #} (toFileChooser chooser) filter

fileChooserGetFilter :: FileChooserClass chooser => chooser -> IO (Maybe FileFilter)
fileChooserGetFilter chooser = do
  ptr <- {# call gtk_file_chooser_get_filter #} (toFileChooser chooser)
  maybePeek (makeNewObject mkFileFilter . return) ptr

fileChooserAddShortcutFolder :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserAddShortcutFolder chooser foldername =
  propagateGError $ \gerrorPtr ->
  withCString foldername $ \strPtr -> do
  {# call gtk_file_chooser_add_shortcut_folder #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserRemoveShortcutFolder :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserRemoveShortcutFolder chooser foldername =
  propagateGError $ \gerrorPtr ->
  withCString foldername $ \strPtr -> do
  {# call gtk_file_chooser_remove_shortcut_folder #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserlistShortcutFolders :: FileChooserClass chooser => chooser -> IO [String]
fileChooserlistShortcutFolders chooser = do
  strList <- {# call gtk_file_chooser_list_shortcut_folders #}
    (toFileChooser chooser)
  fromStringGSList strList

fileChooserAddShortcutFolderURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserAddShortcutFolderURI chooser folderuri =
  propagateGError $ \gerrorPtr ->
  withCString folderuri $ \strPtr -> do
  {# call gtk_file_chooser_add_shortcut_folder_uri #} (toFileChooser chooser)
    strPtr gerrorPtr
  return ()

fileChooserRemoveShortcutFolderURI :: FileChooserClass chooser => chooser -> String -> IO ()
fileChooserRemoveShortcutFolderURI chooser folderuri =
  propagateGError $ \gerrorPtr ->
  withCString folderuri $ \strPtr -> do
  {# call gtk_file_chooser_remove_shortcut_folder_uri #}
    (toFileChooser chooser) strPtr gerrorPtr
  return ()

fileChooserListShortcutFolderURIs :: FileChooserClass chooser => chooser -> IO [String]
fileChooserListShortcutFolderURIs chooser = do
  strList <- {# call gtk_file_chooser_list_shortcut_folder_uris #}
    (toFileChooser chooser)
  fromStringGSList strList

onCurrentFolderChanged, afterCurrentFolderChanged :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" False
afterCurrentFolderChanged = connect_NONE__NONE "current-folder-changed" True

onFileActivated, afterFileActivated :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onFileActivated = connect_NONE__NONE "file-activated" False
afterFileActivated = connect_NONE__NONE "file-activated" True

--onSelectionChanged, afterSelectionChanged :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
--onSelectionChanged = connect_NONE__NONE "selection-changed" False
--afterSelectionChanged = connect_NONE__NONE "selection-changed" True

onUpdatePreview, afterUpdatePreview :: FileChooserClass c => c -> IO () -> IO (ConnectId c)
onUpdatePreview = connect_NONE__NONE "update-preview" False
afterUpdatePreview = connect_NONE__NONE "update-preview" True


------------------------------------------------------
-- Utility functions that really ought to go elsewhere

-- convenience functions for GSlists of strings
fromStringGSList :: GSList -> IO [String]
fromStringGSList strList = do
  strPtrs <- fromGSList strList
  mapM readCString strPtrs

toStringGSList :: [String] -> IO GSList
toStringGSList strs = do
  strPtrs <- mapM newCString strs
  toGSList strPtrs

#endif


--- NEW FILE: FileChooserWidget.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget FileChooserWidget
--
--  Author : Duncan Coutts
--  Created: 24 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
--  The file chooser dialog and widget is a replacement
--  for the old "FileSel"ection dialog. It provides a better user
--  interface and an improved API.
--
-- * This is the widget variant of the "FileChooser"
--
-- * Added in GTK+ 2.4
--
module Graphics.UI.Gtk.Selectors.FileChooserWidget  (
#if GTK_CHECK_VERSION(2,4,0)
  FileChooserWidgetClass,
  FileChooserWidget,
  FileChooserAction,
  fileChooserWidgetNew,
  fileChooserWidgetNewWithBackend,
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

import Monad (liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Selectors.FileChooser#} (FileChooserAction)

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

-- The FileChooserWidget implements the FileChooser interface
-- which we model in Haskell as another instance decleration
instance FileChooserClass FileChooserWidget

fileChooserWidgetNew ::  FileChooserAction -> IO FileChooserWidget
fileChooserWidgetNew action =
  makeNewObject mkFileChooserWidget $ liftM castPtr $
  {# call unsafe gtk_file_chooser_widget_new #}
    (fromIntegral $ fromEnum action)

fileChooserWidgetNewWithBackend ::  FileChooserAction -> String -> IO FileChooserWidget
fileChooserWidgetNewWithBackend action backend =
  makeNewObject mkFileChooserWidget $ liftM castPtr $
  withCString backend $ \strPtr ->
  {# call unsafe gtk_file_chooser_widget_new_with_backend #}
    (fromIntegral $ fromEnum action) strPtr

#endif

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Selectors ColorSelection.chs,NONE,1.1 ColorSelectionDialog.chs,NONE,1.1 FontSelection.chs,NONE,1.1 FontSelectionDialog.chs,NONE,1.1

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

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

Added Files:
	ColorSelection.chs ColorSelectionDialog.chs FontSelection.chs 
	FontSelectionDialog.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: FontSelection.chs ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget FontSelection
--
--  Author : Duncan Coutts
--  Created: 2 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--  documentation Copyright (c) 1995..2000 the GTK+ Team
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--

module Graphics.UI.Gtk.Selectors.FontSelection  (
  fontSelectionNew,
  fontSelectionGetFontName,
  fontSelectionSetFontName,
  fontSelectionGetPreviewText,
  fontSelectionSetPreviewText,
  ) 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" #}


-- | Creates a new 'FontSelection'.
--
fontSelectionNew :: IO FontSelection
fontSelectionNew =
  makeNewObject mkFontSelection $ liftM castPtr $
  {#call unsafe font_selection_new#}

-- | Gets the currently-selected font name. Returns Nothing if no font is
-- selected.
--
fontSelectionGetFontName :: FontSelectionClass obj => obj -> IO (Maybe String)
fontSelectionGetFontName obj =
  {#call unsafe font_selection_get_font_name#} (toFontSelection obj)
    >>= maybePeek readUTFString

-- | Sets the currently-selected font. Returns False if the font was not found.
--
fontSelectionSetFontName :: FontSelectionClass obj => obj -> String -> IO Bool
fontSelectionSetFontName obj fontname = liftM toBool $
  withUTFString fontname $ \strPtr ->
  {#call font_selection_set_font_name#} (toFontSelection obj) strPtr

-- | Gets the text displayed in the preview area.
--
fontSelectionGetPreviewText :: FontSelectionClass obj => obj -> IO String
fontSelectionGetPreviewText obj =
  {#call unsafe font_selection_get_preview_text#} (toFontSelection obj)
    >>= peekUTFString

-- | Sets the text displayed in the preview area.
--
fontSelectionSetPreviewText :: FontSelectionClass obj => obj -> String -> IO ()
fontSelectionSetPreviewText obj text =
  withUTFString text $ \strPtr ->
  {#call font_selection_set_preview_text#} (toFontSelection obj) strPtr

--- NEW FILE: FontSelectionDialog.chs ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget FontSelection
--
--  Author : Duncan Coutts
--  Created: 2 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--  documentation Copyright (c) 1995..2000 the GTK+ Team
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--

module Graphics.UI.Gtk.Selectors.FontSelectionDialog  (
  fontSelectionDialogNew,
  fontSelectionDialogGetFontName,
  fontSelectionDialogSetFontName,
  fontSelectionDialogGetPreviewText,
  fontSelectionDialogSetPreviewText,
  ) 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" #}


-- | Creates a new 'FontSelectionDialog'.
--
fontSelectionDialogNew :: String -> IO FontSelectionDialog
fontSelectionDialogNew title =
  makeNewObject mkFontSelectionDialog $ liftM castPtr $
  withUTFString title $ \strPtr ->
  {#call unsafe font_selection_dialog_new#} strPtr

-- | Gets the currently-selected font name. Returns Nothing if no font is
-- selected.
--
fontSelectionDialogGetFontName :: FontSelectionDialogClass obj => obj
                               -> IO (Maybe String)
fontSelectionDialogGetFontName obj =
  {#call font_selection_dialog_get_font_name#} (toFontSelectionDialog obj)
    >>= maybePeek readUTFString

-- | Sets the currently-selected font. Returns False if the font was not found.
--
fontSelectionDialogSetFontName :: FontSelectionDialogClass obj => obj -> String -> IO Bool
fontSelectionDialogSetFontName obj fontname = liftM toBool $
  withUTFString fontname $ \strPtr ->
  {#call font_selection_dialog_set_font_name#} (toFontSelectionDialog obj)
    strPtr

-- | Gets the text displayed in the preview area.
--
fontSelectionDialogGetPreviewText :: FontSelectionDialogClass obj => obj
                                  -> IO String
fontSelectionDialogGetPreviewText obj =
  {#call unsafe font_selection_dialog_get_preview_text#} (toFontSelectionDialog obj)
    >>= peekUTFString

-- | Sets the text displayed in the preview area.
--
fontSelectionDialogSetPreviewText :: FontSelectionDialogClass obj => obj
                                  -> String -> IO ()
fontSelectionDialogSetPreviewText obj text =
  withUTFString text $ \strPtr ->
  {#call font_selection_dialog_set_preview_text#} (toFontSelectionDialog obj)
    strPtr

--- NEW FILE: ColorSelectionDialog.chs ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ColorSelectionDialog
--
--  Author : Duncan Coutts
--  Created: 2 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--

module Graphics.UI.Gtk.Selectors.ColorSelectionDialog  (
  colorSelectionDialogNew,
  ) 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" #}


-- | Creates a new 'ColorSelectionDialog'.
--
colorSelectionDialogNew :: String -> IO ColorSelectionDialog
colorSelectionDialogNew title =
  makeNewObject mkColorSelectionDialog $ liftM castPtr $
  withUTFString title $ \strPtr ->
  {#call unsafe color_selection_dialog_new#} strPtr

--- NEW FILE: ColorSelection.chs ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ColorSelection
--
--  Author : Duncan Coutts
--  Created: 2 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--  documentation Copyright (c) 1995..2000 the GTK+ Team
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- The ColorSelection is a widget that is used to select a color. It consists of
-- a color wheel and number of sliders and entry boxes for color parameters such
-- as hue, saturation, value, red, green, blue, and opacity. It is found on the
-- standard color selection dialog box "ColorSelectionDialog".
--

module Graphics.UI.Gtk.Selectors.ColorSelection  (
  colorSelectionNew,
  colorSelectionGetCurrentAlpha,
  colorSelectionSetCurrentAlpha,
  colorSelectionGetCurrentColor,
  colorSelectionSetCurrentColor,
  colorSelectionGetHasOpacityControl,
  colorSelectionSetHasOpacityControl,
  colorSelectionGetHasPalette,
  colorSelectionSetHasPalette,
  colorSelectionGetPreviousAlpha,
  colorSelectionSetPreviousAlpha,
  colorSelectionGetPreviousColor,
  colorSelectionSetPreviousColor,
  colorSelectionIsAdjusting
  ) where

import Monad	(liftM)

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

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


-- | Creates a new ColorSelection widget.
--
colorSelectionNew :: IO ColorSelection
colorSelectionNew =
  makeNewObject mkColorSelection $ liftM castPtr $
  {#call unsafe color_selection_new#}

-- | Returns the current alpha value.
--
-- * The alpha value is represented by an integer between 0 and 65535.
--
colorSelectionGetCurrentAlpha :: ColorSelectionClass obj => obj -> IO Int
colorSelectionGetCurrentAlpha obj = liftM fromIntegral $
  {#call unsafe color_selection_get_current_alpha#} (toColorSelection obj)

-- | Sets the current opacity. The first time this is called, it will also set
-- the original opacity too.
--
-- * The alpha value is represented by an integer between 0 and 65535.
--
colorSelectionSetCurrentAlpha :: ColorSelectionClass obj => obj -> Int -> IO ()
colorSelectionSetCurrentAlpha obj alpha =
  {#call color_selection_set_current_alpha#} (toColorSelection obj)
    (fromIntegral alpha)

-- | Gets the current color in the ColorSelection widget.
--
colorSelectionGetCurrentColor :: ColorSelectionClass obj => obj -> IO Color
colorSelectionGetCurrentColor obj =
  alloca $ \colorPtr -> do
  {#call unsafe color_selection_get_current_color#} (toColorSelection obj)
    (castPtr colorPtr)
  peek colorPtr

-- | Sets the current color. The first time this is called, it will also set the
-- original color too.
--
colorSelectionSetCurrentColor :: ColorSelectionClass obj => obj
                              -> Color -> IO ()
colorSelectionSetCurrentColor obj color =
  alloca $ \colorPtr -> do
  poke colorPtr color
  {#call color_selection_set_current_color#} (toColorSelection obj)
    (castPtr colorPtr)

-- | Sets the ColorSelection widget to use or not use opacity.
--
colorSelectionGetHasOpacityControl :: ColorSelectionClass obj => obj -> IO Bool
colorSelectionGetHasOpacityControl obj = liftM toBool $
  {#call unsafe color_selection_get_has_opacity_control#} (toColorSelection obj)

-- | Determines whether the ColorSelection widget has an opacity control.
--
colorSelectionSetHasOpacityControl :: ColorSelectionClass obj => obj
                                   -> Bool -> IO ()
colorSelectionSetHasOpacityControl obj hasOpacity =
  {#call color_selection_set_has_opacity_control#} (toColorSelection obj)
    (fromBool hasOpacity)

-- | Determines whether the color selector has a color palette.
--
colorSelectionGetHasPalette :: ColorSelectionClass obj => obj -> IO Bool
colorSelectionGetHasPalette obj = liftM toBool $
  {#call unsafe color_selection_get_has_palette#} (toColorSelection obj)

-- | Sets whether to show or hide the palette.
--
colorSelectionSetHasPalette :: ColorSelectionClass obj => obj -> Bool -> IO ()
colorSelectionSetHasPalette obj hasPalette =
  {#call color_selection_set_has_palette#} (toColorSelection obj)
    (fromBool hasPalette)

-- | Returns the previous alpha value.
--
colorSelectionGetPreviousAlpha :: ColorSelectionClass obj => obj -> IO Int
colorSelectionGetPreviousAlpha obj = liftM fromIntegral $
  {#call unsafe color_selection_get_previous_alpha#} (toColorSelection obj)

-- | Sets the \'previous\' alpha to the given value. 
--
-- * This function should be called with some hesitations, as it might seem
-- confusing to have that alpha change.
--
colorSelectionSetPreviousAlpha :: ColorSelectionClass obj => obj -> Int -> IO ()
colorSelectionSetPreviousAlpha obj alpha =
  {#call color_selection_set_previous_alpha#} (toColorSelection obj)
    (fromIntegral alpha)

-- | Returns the original color value.
--
colorSelectionGetPreviousColor :: ColorSelectionClass obj => obj -> IO Color
colorSelectionGetPreviousColor obj =
  alloca $ \colorPtr -> do
  {#call unsafe color_selection_get_previous_color#} (toColorSelection obj)
    (castPtr colorPtr)
  peek colorPtr

-- | Sets the \'previous\' color.
--
-- * This function should be called with some hesitations, as it might seem
-- confusing to have that color change.
--
-- * Calling 'colorSelectionSetCurrentColor' will also set this color the first
-- time it is called.
--
colorSelectionSetPreviousColor :: ColorSelectionClass obj => obj
                               -> Color -> IO ()
colorSelectionSetPreviousColor obj color =
  alloca $ \colorPtr -> do
  poke colorPtr color
  {#call color_selection_set_previous_color#} (toColorSelection obj)
    (castPtr colorPtr)

-- | Gets the current state of the widget. Returns True if the user is currently
-- dragging a color around, and False if the selection has stopped.
--
colorSelectionIsAdjusting :: ColorSelectionClass obj => obj -> IO Bool
colorSelectionIsAdjusting obj = liftM toBool $
  {#call unsafe color_selection_is_adjusting#} (toColorSelection obj)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Scrolling HScrollbar.chs,NONE,1.1 ScrolledWindow.chs,NONE,1.1 VScrollbar.chs,NONE,1.1

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

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

Added Files:
	HScrollbar.chs ScrolledWindow.chs VScrollbar.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: VScrollbar.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget VScrollbar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:32:12 $
--
--  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 provides a stand-alone scrollbar. All interesting functions
-- can be found in 'Range', from which it is derived.
--

module Graphics.UI.Gtk.Scrolling.VScrollbar (
  VScrollbar,
  VScrollbarClass,
  castToVScrollbar,
  vScrollbarNew,
  vScrollbarNewDefaults
  ) where

import Monad	(liftM)

import System.Glib.FFI
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 HScrollbar.
--
vScrollbarNew :: Adjustment -> IO VScrollbar
vScrollbarNew adj = makeNewObject mkVScrollbar $ liftM castPtr $
  {#call unsafe vscrollbar_new#} adj

-- | Create a new HScrollbar with a default 'Adjustment'.
--
vScrollbarNewDefaults :: IO VScrollbar
vScrollbarNewDefaults = makeNewObject mkVScrollbar $ liftM castPtr $
  {#call unsafe vscrollbar_new#} (mkAdjustment nullForeignPtr)




--- NEW FILE: ScrolledWindow.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ScrolledWindow
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:32:12 $
--
--  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.
--
-- |
--
-- 'ScrolledWindow' is a container that adds scroll bars to its child
--
-- * Some widgets have native scrolling support, in which case the scrolling action
--   is performed by the child itself (e.g. a TreeView widget does this by only
--   moving the table part and not the titles of a table). If a widget does
--   not support native scrolling it can be put into a 'ScrolledWindow' widget.
--

module Graphics.UI.Gtk.Scrolling.ScrolledWindow (
  ScrolledWindow,
  ScrolledWindowClass,
  castToScrolledWindow,
  scrolledWindowNew,
  scrolledWindowGetHAdjustment,
  scrolledWindowGetVAdjustment,
  PolicyType(..),
  scrolledWindowSetPolicy,
  scrolledWindowGetPolicy,
  scrolledWindowAddWithViewport,
  CornerType(..),
  scrolledWindowSetPlacement,
  scrolledWindowGetPlacement,
  ShadowType(..),
  scrolledWindowSetShadowType,
  scrolledWindowGetShadowType,
  scrolledWindowSetHAdjustment,
  scrolledWindowSetVAdjustment,
  ) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(PolicyType(..), CornerType(..), ShadowType(..))
import Maybe    (fromMaybe)

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

-- methods

-- | Create a new 'ScrolledWindow'.
--
scrolledWindowNew :: Maybe Adjustment -> Maybe Adjustment -> IO ScrolledWindow
scrolledWindowNew hAdj vAdj = makeNewObject mkScrolledWindow $ liftM castPtr $
  {#call unsafe scrolled_window_new#} (fromMAdj hAdj) (fromMAdj vAdj)
 where
 fromMAdj :: Maybe Adjustment -> Adjustment
 fromMAdj = fromMaybe $ mkAdjustment nullForeignPtr

-- | Retrieve the horizontal 'Adjustment' of the 'ScrolledWindow'.
--
scrolledWindowGetHAdjustment :: ScrolledWindowClass w => w -> IO Adjustment
scrolledWindowGetHAdjustment w = makeNewObject mkAdjustment $
  {#call unsafe scrolled_window_get_hadjustment#} (toScrolledWindow w)

-- | Retrieve the vertical 'Adjustment' of the 'ScrolledWindow'.
--
scrolledWindowGetVAdjustment :: ScrolledWindowClass w => w -> IO Adjustment
scrolledWindowGetVAdjustment w = makeNewObject mkAdjustment $
  {#call unsafe scrolled_window_get_vadjustment#} (toScrolledWindow w)

-- | Specify if the scrollbars should vanish if the child size is sufficiently
-- small.
--
scrolledWindowSetPolicy :: ScrolledWindowClass w => w -> PolicyType ->
                           PolicyType -> IO ()
scrolledWindowSetPolicy w hPol vPol = {#call scrolled_window_set_policy#}
  (toScrolledWindow w) ((fromIntegral.fromEnum) hPol) 
  ((fromIntegral.fromEnum) vPol)

-- | Retrieves the current policy values for the horizontal and vertical
-- scrollbars.
--
scrolledWindowGetPolicy :: ScrolledWindowClass w => w
                        -> IO (PolicyType, PolicyType)
scrolledWindowGetPolicy w =
  alloca $ \hPolPtr -> alloca $ \vPolPtr -> do
  {#call unsafe scrolled_window_get_policy#} (toScrolledWindow w)
    hPolPtr vPolPtr
  hPol <- liftM (toEnum.fromIntegral) $ peek hPolPtr
  vPol <- liftM (toEnum.fromIntegral) $ peek vPolPtr
  return (hPol, vPol)

-- | Add a child widget without native scrolling support to this
-- 'ScrolledWindow'.
--
scrolledWindowAddWithViewport :: (ScrolledWindowClass w, WidgetClass wid) => 
                                 w -> wid -> IO ()
scrolledWindowAddWithViewport w wid = 
  {#call scrolled_window_add_with_viewport#} (toScrolledWindow w) 
  (toWidget wid)

-- | Specify where the scrollbars should be placed.
--
scrolledWindowSetPlacement :: ScrolledWindowClass w => w -> CornerType -> IO ()
scrolledWindowSetPlacement w ct =
  {#call scrolled_window_set_placement#} (toScrolledWindow w)
  ((fromIntegral.fromEnum) ct)

-- | Gets the placement of the scrollbars for the scrolled window.
--
scrolledWindowGetPlacement :: ScrolledWindowClass w => w -> IO CornerType
scrolledWindowGetPlacement w = liftM (toEnum.fromIntegral) $
  {#call unsafe scrolled_window_get_placement#} (toScrolledWindow w)

-- | Specify if and how an outer frame should be drawn around the child.
--
scrolledWindowSetShadowType :: ScrolledWindowClass w => w -> ShadowType ->
                               IO ()
scrolledWindowSetShadowType w st = {#call scrolled_window_set_shadow_type#}
  (toScrolledWindow w) ((fromIntegral.fromEnum) st)

-- | Gets the shadow type of the scrolled window.
--
scrolledWindowGetShadowType :: ScrolledWindowClass w => w -> IO ShadowType
scrolledWindowGetShadowType w = liftM (toEnum.fromIntegral) $
  {#call unsafe scrolled_window_get_shadow_type#} (toScrolledWindow w)

-- | Set the horizontal 'Adjustment' of the 'ScrolledWindow'.
--
scrolledWindowSetHAdjustment :: ScrolledWindowClass w => w -> Adjustment ->
                                IO ()
scrolledWindowSetHAdjustment w adj = {#call scrolled_window_set_hadjustment#}
  (toScrolledWindow w) adj

-- | Set the vertical 'Adjustment' of the 'ScrolledWindow'.
--
scrolledWindowSetVAdjustment :: ScrolledWindowClass w => w -> Adjustment ->
                                IO ()
scrolledWindowSetVAdjustment w adj = {#call scrolled_window_set_vadjustment#}
  (toScrolledWindow w) adj



--- NEW FILE: HScrollbar.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget HScrollbar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:32:12 $
--
--  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 provides a stand-alone scrollbar. All interesting functions
-- can be found in 'Range', from which it is derived.
--

module Graphics.UI.Gtk.Scrolling.HScrollbar (
  HScrollbar,
  HScrollbarClass,
  castToHScrollbar,
  hScrollbarNew,
  hScrollbarNewDefaults
  ) where

import Monad	(liftM)

import System.Glib.FFI
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 HScrollbar.
--
hScrollbarNew :: Adjustment -> IO HScrollbar
hScrollbarNew adj = makeNewObject mkHScrollbar $ liftM castPtr $
  {#call unsafe hscrollbar_new#} adj

-- | Create a new HScrollbar without an 'Adjustment'.
--
hScrollbarNewDefaults :: IO HScrollbar
hScrollbarNewDefaults = makeNewObject mkHScrollbar $ liftM castPtr $
  {#call unsafe hscrollbar_new#} (mkAdjustment nullForeignPtr)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Pango Enums.chs,NONE,1.1 Markup.hs,NONE,1.1 Rendering.chs,NONE,1.1 Types.chs.pp,NONE,1.1

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

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

Added Files:
	Enums.chs Markup.hs Rendering.chs Types.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Markup.hs ---
--  GIMP Toolkit (GTK) Markup
--
--  Author : Axel Simon
--          
--  Created: 5 June 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  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 module defines some helper functions for generating texts with
-- embedded attributes.
--
-- TODO
--
-- * Add a numeric value to 'FontWeightDef'.
--
module Graphics.UI.Gtk.Pango.Markup (
  Markup,
  SpanAttribute(..),
  markSpan,
  Size(..)
  ) where

import Graphics.UI.Gtk.Pango.Types ( Language )
import qualified Graphics.UI.Gtk.Pango.Enums as Pango

-- | Define a synonym for text with embedded markup commands.
--
-- * Markup strings are just simple strings. But it's easier to tell if a
--   method expects text with or without markup.
--
type Markup = String

-- | These are all the attributes the 'markSpan' function can express.
--
data SpanAttribute
  -- | Choose a font by textual description.
  --
  -- * Takes a string to completely describe the font, example:
  -- @FontDescr@ \"Sans Italic 12\"
  = FontDescr   String

  -- | Specify the family of font to use.
  --
  -- * Example: @FontFamily@ \"Sans\"
  | FontFamily	String

  -- | Change the size of the current font.
  --
  -- * The constuctor takes the size in points (pt) or a predefined
  --   sizes. Setting the absolute size 12.5pt can be achieved by passing
  --   'FontSize' ('SizePoint' 12.5) to 'markSpan'. Next to predefined
  --   absolute sizes such as 'SizeSmall' the size can be changed by 
  --   asking for the next larger or smaller front with
  --   'SizeLarger' and 'SizeSmaller', respectively.
  | FontSize Size

  -- | Change the slant of the current font.
  --
  | FontStyle Pango.FontStyle

  -- | Change the thickness of the current font.
  --
  -- * The constructor takes one of the six predefined weights. Most likely to
  --   be supported: 'WeightBold'.
  --
  | FontWeight Pango.Weight

  -- | Choosing an alternative rendering for lower case letters.
  --
  -- * The argument 'VariangtSmallCaps' will display lower case letters
  --   as smaller upper case letters, if this option is available.
  | FontVariant Pango.Variant

  -- | Choose a different width.
  --
  -- * Takes one of nine font widths, e.g. 'WidthExpanded'.
  --
  | FontStretch Pango.Stretch

  -- | Foreground color.
  --
  -- * This constructor and 'FontBackground' take both a description
  --   of the color to be used for rendering.
  | FontForeground String	-- FIXME: should be ColorName from GDK or so

  -- | Background color.
  | FontBackground String

  -- | Specify underlining of text.
  --
  | FontUnderline Pango.Underline

  -- | Specify a vertical displacement.
  --
  -- * Takes the vertical displacement in em (the width of the \'m\' character
  --   in the current font).
  | FontRise	Double

  -- | Give a hint about the language to be displayed.
  --
  -- * This hint might help the system rendering a particular piece of text
  --   with different fonts that are more suitable for the given language.
  --
  | FontLang	Language

instance Show SpanAttribute where
  showsPrec _ (FontDescr str)    = showString " font_desc=".shows str
  showsPrec _ (FontFamily str)	 = showString " font_family=".shows str
  showsPrec _ (FontSize size)	 = showString " size=".shows size
  showsPrec _ (FontStyle style)  = showString " style=".shows style
  showsPrec _ (FontWeight w)	 = showString " weight=".shows w
  showsPrec _ (FontVariant v)	 = showString " variant=".shows v
  showsPrec _ (FontStretch s)	 = showString " stretch=".shows s
  showsPrec _ (FontForeground c) = showString " foreground=".shows c
  showsPrec _ (FontBackground c) = showString " background=".shows c
  showsPrec _ (FontUnderline u)	 = showString " underline=".shows u
  showsPrec _ (FontRise r)	 = showString " rise=".shows 
				   (show (round (r*10000)))
  showsPrec _ (FontLang l)	 = showString " lang=".shows l

-- | Create the most generic span attribute.
--
markSpan :: [SpanAttribute] -> String -> String
markSpan attrs text = showString "<span".
		      foldr (.) (showChar '>') (map shows attrs).
		      showString text.
		      showString "</span>" $ ""

-- | Define attributes for 'FontSize'.
--
data Size
  = SizePoint Double
  | SizeUnreadable
  | SizeTiny
  | SizeSmall
  | SizeMedium
  | SizeLarge
  | SizeHuge
  | SizeGiant
  | SizeSmaller
  | SizeLarger

instance Show Size where
  showsPrec _ (SizePoint v)        	= shows $ show (round (v*1000))
  showsPrec _ (SizeUnreadable)		= shows "xx-small"
  showsPrec _ (SizeTiny)		= shows "x-small"
  showsPrec _ (SizeSmall)		= shows "small"
  showsPrec _ (SizeMedium)		= shows "medium"
  showsPrec _ (SizeLarge)		= shows "large"
  showsPrec _ (SizeHuge)		= shows "x-large"
  showsPrec _ (SizeGiant)		= shows "xx-large"
  showsPrec _ (SizeSmaller)		= shows "smaller"
  showsPrec _ (SizeLarger)	  	= shows "larger"





--- NEW FILE: Enums.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Enumerations for Pango.
--
--  Author : Axel Simon
--          
--  Created: 12 September 2004
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  Copyright (c) 1999..2004 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.
--
-- |
--
-- Enumerations for describing font characteristics.
--
module Graphics.UI.Gtk.Pango.Enums (
  FontStyle(..),
  Weight(..),
  Variant(..),
  Stretch(..),
  Underline(..)
  ) where

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

-- | The style of a font.
--
-- * 'StyleOblique' is a slanted font like 'StyleItalic', 
--   but in a roman style.
--
{#enum Style as FontStyle {underscoreToCase}#}

instance Show FontStyle where
  showsPrec _ StyleNormal	   = shows "normal"
  showsPrec _ StyleOblique	   = shows "oblique"
  showsPrec _ StyleItalic	   = shows "italic"

-- | Define attributes for 'FontWeight'.
--
{#enum Weight {underscoreToCase}#}

instance Show Weight where
  showsPrec _ WeightUltralight	= shows "ultralight"
  showsPrec _ WeightLight	= shows "light"
  showsPrec _ WeightNormal	= shows "normal"
  showsPrec _ WeightBold	= shows "bold"
  showsPrec _ WeightUltrabold 	= shows "ultrabold"
  showsPrec _ WeightHeavy	= shows "heavy"

-- | The variant of a font.
--
-- * The 'VariantCmallCaps' is a version of a font where lower case
--   letters are shown as physically smaller upper case letters.
--
{#enum Variant {underscoreToCase}#}

instance Show Variant where
  showsPrec _ VariantNormal       = shows "normal"
  showsPrec _ VariantSmallCaps    = shows "smallcaps"

-- | Define how wide characters are.
--
{#enum Stretch {underscoreToCase}#}

instance Show Stretch where
  showsPrec _ StretchUltraCondensed	= shows "ultracondensed"
  showsPrec _ StretchExtraCondensed	= shows "extracondensed"
  showsPrec _ StretchCondensed		= shows "condensed"
  showsPrec _ StretchSemiCondensed	= shows "semicondensed"
  showsPrec _ StretchNormal		= shows "normal"
  showsPrec _ StretchSemiExpanded	= shows "semiexpanded"
  showsPrec _ StretchExpanded		= shows "expanded"
  showsPrec _ StretchExtraExpanded	= shows "extraexpanded"
  showsPrec _ StretchUltraExpanded	= shows "ultraexpanded"

-- | Define attributes for 'FontUnderline'.
--
{#enum Underline {underscoreToCase}#}

instance Show Underline where
  showsPrec _ UnderlineNone	= shows "none"
  showsPrec _ UnderlineSingle	= shows "single"
  showsPrec _ UnderlineDouble	= shows "double"
  showsPrec _ UnderlineLow	= shows "low"
  showsPrec _ UnderlineError	= shows "error"


--- NEW FILE: Types.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) - pango non-GObject types PangoTypes
--
--  Author : Axel Simon
--          
--  Created: 9 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- Define types used in Pango which are not derived from GObject.
--
module Graphics.UI.Gtk.Pango.Types (
  LayoutIter(LayoutIter),
  layout_iter_free,
  LayoutLine(LayoutLine),
  makeNewLayoutLine,
  FontDescription(FontDescription),
  makeNewFontDescription,
  Language(Language),
  emptyLanguage,
  languageFromString
  ) where

import Monad    (liftM)

import System.Glib.FFI
import System.Glib.UTFString

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

-- entry PangoLayout

-- | An iterator to examine a layout.
--
{#pointer *PangoLayoutIter as LayoutIter foreign newtype #}


#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_iter_free"
  layout_iter_free' :: FinalizerPtr LayoutIter

layout_iter_free :: Ptr LayoutIter -> FinalizerPtr LayoutIter
layout_iter_free _ = layout_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "pango_layout_iter_free"
  layout_iter_free :: Ptr LayoutIter -> IO ()

#else

foreign import ccall "pango_layout_iter_free" unsafe
  layout_iter_free :: Ptr LayoutIter -> IO ()

#endif

-- | A single line in a 'PangoLayout'.
--
{#pointer *PangoLayoutLine as LayoutLine foreign newtype #}

makeNewLayoutLine :: Ptr LayoutLine -> IO LayoutLine
makeNewLayoutLine llPtr = do
  liftM LayoutLine $ newForeignPtr llPtr (pango_layout_line_unref llPtr)


#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_line_unref"
  pango_layout_line_unref' :: FinalizerPtr LayoutLine

pango_layout_line_unref :: Ptr LayoutLine -> FinalizerPtr LayoutLine
pango_layout_line_unref _ = pango_layout_line_unref'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "pango_layout_line_unref"
  pango_layout_line_unref :: Ptr LayoutLine -> IO ()

#else

foreign import ccall "pango_layout_line_unref" unsafe
  pango_layout_line_unref :: Ptr LayoutLine -> IO ()

#endif

#if __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "pango_layout_line_ref"
  pango_layout_line_ref :: Ptr LayoutLine -> IO ()

#else

foreign import ccall "pango_layout_line_ref" unsafe
  pango_layout_line_ref :: Ptr LayoutLine -> IO ()

#endif


-- | A possibly partial description of font(s).
--
{#pointer *PangoFontDescription as FontDescription foreign newtype #}

makeNewFontDescription :: Ptr FontDescription -> IO FontDescription
makeNewFontDescription llPtr = do
  liftM FontDescription $ newForeignPtr llPtr
	    (pango_font_description_free llPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_font_description_free"
  pango_font_description_free' :: FinalizerPtr FontDescription

pango_font_description_free :: Ptr FontDescription -> 
				FinalizerPtr FontDescription
pango_font_description_free _ = pango_font_description_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "pango_font_description_free"
  pango_font_description_free :: Ptr FontDescription -> IO ()

#else

foreign import ccall "pango_font_description_free" unsafe
  pango_font_description_free :: Ptr FontDescription -> IO ()

#endif

-- | A Language designator to choose fonts.
--
{#pointer* Language newtype#} deriving Eq

instance Show Language where
  show (Language ptr)
    | ptr==nullPtr = ""
    | otherwise = unsafePerformIO $ peekUTFString (castPtr ptr)

-- | Specifying no particular language.
emptyLanguage = Language nullPtr

languageFromString :: String -> IO Language
languageFromString language = liftM Language $
  withUTFString language {#call language_from_string#}

--- NEW FILE: Rendering.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) - text layout functions Rendering
--
--  Author : Axel Simon
--          
--  Created: 8 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- Functions to run the rendering pipeline.
--
-- * The Pango rendering pipeline takes a string of Unicode characters
--   and converts it into glyphs.  The functions described in this module
--   accomplish various steps of this process.
--
module Graphics.UI.Gtk.Pango.Rendering (
  PangoContext,
  contextListFamilies,
--  contextLoadFont,
--  contextLoadFontSet,
  contextGetMetrics,
  FontMetrics(..),
  contextSetFontDescription,
  contextGetFontDescription,
  contextSetLanguage,
  contextGetLanguage,
  contextSetTextDir,
  contextGetTextDir,
  TextDirection(..)
  ) where

import Monad    (liftM)
import Data.Ratio

import System.Glib.FFI
import Graphics.UI.Gtk.General.Structs  (pangoScale)
{#import Graphics.UI.Gtk.Types#}
import System.Glib.GObject  (makeNewGObject)
import Graphics.UI.Gtk.General.Enums
{#import Graphics.UI.Gtk.Pango.Types#}

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


-- | Retrieve a list of all available font families.
--
-- * A font family is the name of the font without further attributes
--   like slant, variant or size.
--
contextListFamilies :: PangoContext -> IO [FontFamily]
contextListFamilies c = alloca $ \sizePtr -> alloca $ \ptrPtr -> do
  {#call unsafe context_list_families#} c ptrPtr sizePtr
  ptr <- peek ptrPtr
  size <- peek sizePtr
  -- c2hs get FontFamily*** wrong as FontFamily**, therefore the cast
  familyPtrs <- peekArray (fromIntegral size) (castPtr ptr)
  fams <- mapM (makeNewGObject mkFontFamily . return) familyPtrs
  {#call unsafe g_free#} (castPtr ptr)
  return fams

-- | Load a font.
--
--contextLoadFont :: PangoContext -> FontDescription -> Language ->
--		   IO (Maybe Font)
--contextLoadFont pc fd l = do
--  fsPtr <- {#call context_load_font#} pc fd l
--  if fsPtr==nullPtr then return Nothing else
--    liftM Just $ makeNewGObject mkFont (return fsPtr)

-- | Load a font set.
--
--contextLoadFontSet :: PangoContext -> FontDescription -> Language ->
--		      IO (Maybe FontSet)
--contextLoadFontSet pc fd l = do
--  fsPtr <- {#call context_load_fontset#} pc fd l
--  if fsPtr==nullPtr then return Nothing else
--    liftM Just $ makeNewGObject mkFontSet (return fsPtr)

-- | Query the metrics of the given font implied by the font description.
--
contextGetMetrics :: PangoContext -> FontDescription -> Language ->
		     IO FontMetrics
contextGetMetrics pc fd l = do
  mPtr <- {#call unsafe context_get_metrics#} pc fd l
  ascend <- liftM fromIntegral $ {#call unsafe font_metrics_get_ascent#} mPtr
  descend <- liftM fromIntegral $ {#call unsafe font_metrics_get_descent#} mPtr
  cWidth <- liftM fromIntegral $
	    {#call unsafe font_metrics_get_approximate_char_width#} mPtr
  dWidth <- liftM fromIntegral $
	    {#call unsafe font_metrics_get_approximate_digit_width#} mPtr
  {#call unsafe font_metrics_unref#} mPtr
  return (FontMetrics
	  (ascend % pangoScale)
	  (descend % pangoScale)
	  (cWidth % pangoScale)
	  (dWidth % pangoScale))

-- | The characteristic measurements of a font.
--
-- * All values are measured in pixels.
--
data FontMetrics = FontMetrics {
  -- | The ascent is the distance from the baseline to the logical top
  --   of a line of text. (The logical top may be above or below the
  --   top of the actual drawn ink. It is necessary to lay out the
  --   text to figure where the ink will be.)
  ascent :: Rational,
  -- | The descent is the distance from the baseline to the logical
  --   bottom of a line of text. (The logical bottom may be above or
  --   below the bottom of the actual drawn ink. It is necessary to
  --   lay out the text to figure where the ink will be.)
  descent :: Rational,
  -- | The approximate character width. This is merely a
  --   representative value useful, for example, for determining the
  --   initial size for a window. Actual characters in text will be
  --   wider and narrower than this.
  approximateCharWidth :: Rational,
  -- | The approximate digit widt. This is merely a representative
  --   value useful, for example, for determining the initial size for
  --   a window. Actual digits in text can be wider and narrower than
  --   this, though this value is generally somewhat more accurate
  --   than @approximateCharWidth@.
  approximateDigitWidth :: Rational
}

-- | Set the default 'FontDescription' of this context.
--
contextSetFontDescription :: PangoContext -> FontDescription -> IO ()
contextSetFontDescription pc fd =
  {#call unsafe context_set_font_description#} pc fd

-- | Get the current 'FontDescription' of this context.
--
contextGetFontDescription :: PangoContext -> IO FontDescription
contextGetFontDescription pc = do
  fdPtrConst <- {#call unsafe context_get_font_description#} pc
  fdPtr <- pango_font_description_copy fdPtrConst
  makeNewFontDescription fdPtr

foreign import ccall unsafe "pango_font_description_copy"
  pango_font_description_copy :: Ptr FontDescription -> 
				 IO (Ptr FontDescription)

-- | Set the default 'Language' of this context.
--
contextSetLanguage :: PangoContext -> Language -> IO ()
contextSetLanguage = {#call unsafe context_set_language#}

-- | Get the current 'Language' of this context.
--
contextGetLanguage :: PangoContext -> IO Language
contextGetLanguage pc = liftM Language $
			{#call unsafe context_get_language#} pc

-- only used internally
{#enum PangoDirection {underscoreToCase} #}

-- | Set the default text direction of this context.
--
contextSetTextDir :: PangoContext -> TextDirection -> IO ()
contextSetTextDir pc dir =
  {#call unsafe context_set_base_dir#} pc (convert dir)
  where
    convert TextDirNone = fromIntegral (fromEnum DirectionNeutral)
    convert TextDirLtr = fromIntegral (fromEnum DirectionLtr)
    convert TextDirRtl = fromIntegral (fromEnum DirectionRtl)

-- | Get the current text direction of this context.
--
contextGetTextDir :: PangoContext -> IO TextDirection
contextGetTextDir pc = liftM (convert . toEnum . fromIntegral) $
		       {#call unsafe context_get_base_dir#} pc
  where
  convert DirectionLtr = TextDirLtr
  convert DirectionRtl = TextDirRtl
  convert _ = TextDirNone

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Pango Layout.chs,NONE,1.1 Description.chs,NONE,1.1

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

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

Added Files:
	Layout.chs Description.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Layout.chs ---
--  GIMP Toolkit (GTK) - text layout functions PangoLayout
--
--  Author : Axel Simon
--          
--  Created: 8 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:04 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- Functions to run the rendering pipeline.
--
-- * The Pango rendering pipeline takes a string of Unicode characters
--   and converts it into glyphs.  The functions described in this module
--   accomplish various steps of this process.
--
-- TODO
--
-- * Functions that are missing:
--   pango_layout_set_attributes, pango_layout_get_attributes,
--   pango_layout_set_font_description, pango_layout_set_tabs,
--   pango_layout_get_tabs, pango_layout_get_log_attrs, 
--   pango_layout_iter_get_run
--
-- * The following functions cannot be bound easily due to Unicode\/UTF8 issues:
--   pango_layout_xy_to_index, pango_layout_index_to_pos,
--   pango_layout_get_cursor_pos, pango_layout_move_cursor_visually,
--   pango_layout_iter_get_index, pango_layout_line_index_to_x,
--   pango_layout_line_x_to_index, pango_layout_line_get_x_ranges
--
-- * These functions are not bound, because they're too easy:
--   pango_layout_get_size, pango_layout_get_pixel_size,
--   pango_layout_get_line 
--
module Graphics.UI.Gtk.Pango.Layout (
  PangoLayout,
  layoutCopy,
  layoutGetContext,
  layoutContextChanged,
  layoutSetText,
  layoutGetText,
  layoutSetMarkup,
  layoutSetMarkupWithAccel,
  layoutSetWidth,
  layoutGetWidth,
  LayoutWrapMode(..),
  layoutSetWrap,
  layoutGetWrap,
  layoutSetIndent,
  layoutGetIndent,
  layoutSetSpacing,
  layoutGetSpacing,
  layoutSetJustify,
  layoutGetJustify,
  LayoutAlignment(..),
  layoutSetAlignment,
  layoutGetAlignment,
  layoutSetSingleParagraphMode,
  layoutGetSingleParagraphMode,
  layoutGetExtents,
  layoutGetPixelExtents,
  layoutGetLineCount,
  layoutGetLines,
  LayoutIter,
  layoutGetIter,
  layoutIterNextRun,
  layoutIterNextChar,
  layoutIterNextCluster,
  layoutIterNextLine,
  layoutIterAtLastLine,
  layoutIterGetBaseline,
  layoutIterGetLine,
  layoutIterGetCharExtents,
  layoutIterGetClusterExtents,
  layoutIterGetRunExtents,
  layoutIterGetLineYRange,
  layoutIterGetLineExtents,
  LayoutLine,
  layoutLineGetExtents,
  layoutLineGetPixelExtents
  ) where

import Monad    (liftM)
import Char     (ord, chr)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GList                (readGSList)
import System.Glib.GObject              (makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
import Graphics.UI.Gtk.Pango.Markup	(Markup)
import Graphics.UI.Gtk.General.Enums
import Graphics.UI.Gtk.General.Structs	(Rectangle)
{#import Graphics.UI.Gtk.Pango.Types#}

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

-- | Create a copy of the 'Layout'.
--
layoutCopy :: PangoLayout -> IO PangoLayout
layoutCopy pl = makeNewGObject mkPangoLayout 
		 ({#call unsafe layout_copy#} (toPangoLayout pl))

-- | Retrieves the 'PangoContext' from this
-- layout.
--
layoutGetContext :: PangoLayout -> IO PangoContext
layoutGetContext pl = makeNewGObject mkPangoContext
		      ({#call unsafe layout_get_context#} pl)

-- | Signal a 'Context' change.
--
-- * Forces recomputation of any state in the 'PangoLayout' that
--   might depend on the layout's context. This function should
--   be called if you make changes to the context subsequent
--   to creating the layout.
--
layoutContextChanged :: PangoLayout -> IO ()
layoutContextChanged pl = {#call unsafe layout_context_changed#} pl

-- | Set the string in the layout.
--
layoutSetText :: PangoLayout -> String -> IO ()
layoutSetText pl txt = withUTFStringLen txt $ \(strPtr,len) ->
  {#call unsafe layout_set_text#} pl strPtr (fromIntegral len)

-- | Retrieve the string in the layout.
--
layoutGetText :: PangoLayout -> IO String
layoutGetText pl = {#call unsafe layout_get_text#} pl >>= peekUTFString

-- | Set the string in the layout.
--
-- * The string may include 'Markup'.
--
layoutSetMarkup :: PangoLayout -> Markup -> IO ()
layoutSetMarkup pl txt = withUTFStringLen txt $ \(strPtr,len) ->
  {#call unsafe layout_set_markup#} pl strPtr (fromIntegral len)

-- | Set the string in the layout.
--
-- * The string may include 'Markup'. Furthermore, any underscore
--   character indicates that the next character should be
--   marked as accelerator (i.e. underlined). A literal underscore character
--   can be produced by placing it twice in the string.
--
-- * The character which follows the underscore is
--   returned so it can be used to add the actual keyboard shortcut. 
--
layoutSetMarkupWithAccel :: PangoLayout -> Markup -> IO Char
layoutSetMarkupWithAccel pl txt =
  alloca $ \chrPtr -> 
  withUTFStringLen txt $ \(strPtr,len) -> do
    {#call unsafe layout_set_markup_with_accel#} pl strPtr (fromIntegral len)
      (fromIntegral (ord '_')) chrPtr
    liftM (chr.fromIntegral) $ peek chrPtr


-- there are a couple of functions missing here

-- | Set the width of this paragraph.
--
-- * Sets the width to which the lines of the 'PangoLayout'
--   should be wrapped.
--
-- * @width@ is the desired width, or @-1@ to indicate that
--   no wrapping should be performed.
--
layoutSetWidth :: PangoLayout -> Int -> IO ()
layoutSetWidth pl width =
  {#call unsafe layout_set_width#} pl (fromIntegral width)

-- | Gets the width of this paragraph.
--
-- * Gets the width to which the lines of the 'PangoLayout'
--   should be wrapped.
--
-- * Returns is the current width, or @-1@ to indicate that
--   no wrapping is performed.
--
layoutGetWidth :: PangoLayout -> IO Int
layoutGetWidth pl = liftM fromIntegral $ {#call unsafe layout_get_width#} pl


-- | Enumerates how a line can be wrapped.
--
-- [@WrapWholeWords@] Breaks lines only between words.
--
-- * This variant does not guarantee that the requested width is not
--   exceeded. A word that is longer than the paragraph width is not
--   split.
--
-- [@WrapAnywhere@] Break lines anywhere.
--
-- [@WrapPartialWords@] Wrap within a word if it is the only one on
-- this line.
--
-- * This option acts like 'WrapWholeWords' but will split
--   a word if it is the only one on this line and it exceeds the
--   specified width.
--
{#enum PangoWrapMode as LayoutWrapMode 
  {underscoreToCase,
  PANGO_WRAP_WORD as WrapWholeWords,
  PANGO_WRAP_CHAR as WrapAnywhere,
  PANGO_WRAP_WORD_CHAR as WrapPartialWords}#}

-- | Set how this paragraph is wrapped.
--
-- * Sets the wrap style; the wrap style only has an effect if a width
--   is set on the layout with 'layoutSetWidth'. To turn off
--   wrapping, set the width to -1.
--
layoutSetWrap :: PangoLayout -> LayoutWrapMode -> IO ()
layoutSetWrap pl wm =
  {#call unsafe layout_set_wrap#} pl ((fromIntegral.fromEnum) wm)


-- | Get the wrap mode for the layout.
--
layoutGetWrap :: PangoLayout -> IO LayoutWrapMode
layoutGetWrap pl = liftM (toEnum.fromIntegral) $
  {#call unsafe layout_get_wrap#} pl

-- | Set the indentation of this paragraph.
--
-- * Sets the amount by which the first line should be shorter than
--   the rest of the lines. This may be negative, in which case the
--   subsequent lines will be shorter than the first line. (However, in
--   either case, the entire width of the layout will be given by the
--   value.
--
layoutSetIndent :: PangoLayout -> Int -> IO ()
layoutSetIndent pl indent =
  {#call unsafe layout_set_indent#} pl (fromIntegral indent)

-- | Gets the indentation of this paragraph.
--
-- * Gets the amount by which the first line should be shorter than 
--   the rest of the lines.
--
layoutGetIndent :: PangoLayout -> IO Int
layoutGetIndent pl = liftM fromIntegral $ {#call unsafe layout_get_indent#} pl


-- | Set the spacing between lines of this paragraph.
--
layoutSetSpacing :: PangoLayout -> Int -> IO ()
layoutSetSpacing pl spacing =
  {#call unsafe layout_set_spacing#} pl (fromIntegral spacing)

-- | Gets the spacing between the lines.
--
layoutGetSpacing :: PangoLayout -> IO Int
layoutGetSpacing pl = 
  liftM fromIntegral $ {#call unsafe layout_get_spacing#} pl

-- | Set if text should be streched to fit width.
--
-- * Sets whether or not each complete line should be stretched to
--   fill the entire width of the layout. This stretching is typically
--   done by adding whitespace, but for some scripts (such as Arabic),
--   the justification is done by extending the characters.
--
layoutSetJustify :: PangoLayout -> Bool -> IO ()
layoutSetJustify pl j = {#call unsafe layout_set_justify#} pl (fromBool j)

-- | Retrieve the justification flag.
--
-- * See 'layoutSetJustify'.
--
layoutGetJustify :: PangoLayout -> IO Bool
layoutGetJustify pl = liftM toBool $ {#call unsafe layout_get_justify#} pl

-- | Enumerate to which side incomplete lines are flushed.
--
{#enum PangoAlignment as LayoutAlignment {underscoreToCase}#}

-- | Set how this paragraph is aligned.
--
-- * Sets the alignment for the layout (how partial lines are
--   positioned within the horizontal space available.)
--
layoutSetAlignment :: PangoLayout -> LayoutAlignment -> IO ()
layoutSetAlignment pl am =
  {#call unsafe layout_set_alignment#} pl ((fromIntegral.fromEnum) am)


-- | Get the alignment for the layout.
--
layoutGetAlignment :: PangoLayout -> IO LayoutAlignment
layoutGetAlignment pl = liftM (toEnum.fromIntegral) $
  {#call unsafe layout_get_alignment#} pl

-- functions are missing here

-- | Honor newlines or not.
--
-- * If @honor@ is @True@, do not treat newlines and
--   similar characters as paragraph separators; instead, keep all text in
--   a single paragraph, and display a glyph for paragraph separator
--   characters. Used when you want to allow editing of newlines on a
--   single text line.
--
layoutSetSingleParagraphMode :: PangoLayout -> Bool -> IO ()
layoutSetSingleParagraphMode pl honor = 
  {#call unsafe layout_set_single_paragraph_mode#} pl (fromBool honor)

-- | Retrieve if newlines are honored.
--
-- * See 'layoutSetSingleParagraphMode'.
--
layoutGetSingleParagraphMode :: PangoLayout -> IO Bool
layoutGetSingleParagraphMode pl = 
  liftM toBool $ {#call unsafe layout_get_single_paragraph_mode#} pl

-- a function is missing here

-- | Compute the physical size of the layout.
--
-- * Computes the logical and the ink size of the 'Layout'. The
--   logical layout is used for positioning, the ink size is the smallest
--   bounding box that includes all character pixels. The ink size can be
--   smaller or larger that the logical layout.
--
-- * All values are in layout units. To get to device units (pixel for
--   'Drawable's) divide by 'pangoScale'.
--
layoutGetExtents :: PangoLayout -> IO (Rectangle, Rectangle)
layoutGetExtents pl = alloca $ \logPtr -> alloca $ \inkPtr -> do
  {#call unsafe layout_get_extents#} pl (castPtr logPtr) (castPtr inkPtr)
  log <- peek logPtr
  ink <- peek inkPtr
  return (log,ink)


-- | Compute the physical size of the layout.
--
-- * Computes the logical and the ink size of the 'Layout'. The
--   logical layout is used for positioning, the ink size is the smallest
--   bounding box that includes all character pixels. The ink size can be
--   smaller or larger that the logical layout.
--
-- * All values are in device units. This function is a wrapper around
--   'layoutGetExtents' with scaling.
--
layoutGetPixelExtents :: PangoLayout -> IO (Rectangle, Rectangle)
layoutGetPixelExtents pl = alloca $ \logPtr -> alloca $ \inkPtr -> do
  {#call unsafe layout_get_pixel_extents#} pl (castPtr logPtr) (castPtr inkPtr)
  log <- peek logPtr
  ink <- peek inkPtr
  return (log,ink)

-- | Ask for the number of lines in this layout.
--
layoutGetLineCount :: PangoLayout -> IO Int
layoutGetLineCount pl = liftM fromIntegral $
  {#call unsafe layout_get_line_count#} pl

-- | Extract the single lines of the layout.
--
-- * The lines of each layout are regenerated if any attribute changes.
--   Thus the returned list does not reflect the current state of lines
--   after a change has been made.
--
layoutGetLines :: PangoLayout -> IO [LayoutLine]
layoutGetLines pl = do
  listPtr <- {#call unsafe layout_get_lines#} pl
  list <- readGSList listPtr
  mapM makeNewLayoutLine list

-- | Create an iterator to examine a layout.
--
layoutGetIter :: PangoLayout -> IO LayoutIter
layoutGetIter pl = do
  iterPtr <- {#call unsafe layout_get_iter#} pl
  liftM LayoutIter $ newForeignPtr iterPtr (layout_iter_free iterPtr)

-- | Move to the next run.
--
-- * Returns @False@ if this was the last run in the layout.
--
layoutIterNextRun :: LayoutIter -> IO Bool
layoutIterNextRun = liftM toBool . {#call unsafe layout_iter_next_run#}

-- | Move to the next char.
--
-- * Returns @False@ if this was the last char in the layout.
--
layoutIterNextChar :: LayoutIter -> IO Bool
layoutIterNextChar = liftM toBool . {#call unsafe layout_iter_next_char#}

-- | Move to the next cluster.
--
-- * Returns @False@ if this was the last cluster in the layout.
--
layoutIterNextCluster :: LayoutIter -> IO Bool
layoutIterNextCluster = liftM toBool . {#call unsafe layout_iter_next_cluster#}

-- | Move to the next line.
--
-- * Returns @False@ if this was the last line in the layout.
--
layoutIterNextLine :: LayoutIter -> IO Bool
layoutIterNextLine = liftM toBool . {#call unsafe layout_iter_next_line#}

-- | Check if the iterator is on the last line.
--
-- * Returns @True@ if the iterator is on the last line of this
--   paragraph.
--
layoutIterAtLastLine :: LayoutIter -> IO Bool
layoutIterAtLastLine = liftM toBool . {#call unsafe layout_iter_at_last_line#}

-- | Query the vertical position within the
-- layout.
--
-- * Gets the y position of the current line's baseline, in layout
--   coordinates (origin at top left of the entire layout).
--
layoutIterGetBaseline :: LayoutIter -> IO Int
layoutIterGetBaseline = 
  liftM fromIntegral . {#call unsafe pango_layout_iter_get_baseline#}

-- pango_layout_iter_get_run goes here

-- | Extract the line under the iterator.
--
layoutIterGetLine :: LayoutIter -> IO (Maybe LayoutLine)
layoutIterGetLine li = do
  llPtr <- liftM castPtr $ {#call unsafe pango_layout_iter_get_line#} li
  if (llPtr==nullPtr) then return Nothing else 
    liftM Just $ makeNewLayoutLine llPtr

-- | Retrieve a rectangle surrounding
-- a character.
--
-- * Get the extents of the current character in layout cooridnates
--   (origin is the top left of the entire layout). Only logical extents
--   can sensibly be obtained for characters. 
--
layoutIterGetCharExtents :: LayoutIter -> IO Rectangle
layoutIterGetCharExtents li = alloca $ \logPtr -> 
  {#call unsafe layout_iter_get_char_extents#} li (castPtr logPtr) >>
  peek logPtr

-- | Compute the physical size of the
-- cluster.
--
-- * Computes the logical and the ink size of the cluster pointed to by
--   'LayoutIter'.
--
-- * All values are in layoutIter units. To get to device units (pixel for
--   'Drawable's) divide by 'pangoScale'.
--
layoutIterGetClusterExtents :: LayoutIter -> IO (Rectangle, Rectangle)
layoutIterGetClusterExtents li = alloca $ \logPtr -> alloca $ \inkPtr -> do
  {#call unsafe layout_iter_get_cluster_extents#} li (castPtr logPtr)
    (castPtr inkPtr)
  log <- peek logPtr
  ink <- peek inkPtr
  return (log,ink)

-- | Compute the physical size of the run.
--
-- * Computes the logical and the ink size of the run pointed to by
--   'LayoutIter'.
--
-- * All values are in layoutIter units. To get to device units (pixel for
--   'Drawable's) divide by 'pangoScale'.
--
layoutIterGetRunExtents :: LayoutIter -> IO (Rectangle, Rectangle)
layoutIterGetRunExtents li = alloca $ \logPtr -> alloca $ \inkPtr -> do
  {#call unsafe layout_iter_get_run_extents#} li (castPtr logPtr)
    (castPtr inkPtr)
  log <- peek logPtr
  ink <- peek inkPtr
  return (log,ink)

-- | Retrieve vertical extent of this
-- line.
--
-- * Divides the vertical space in the 'PangoLayout' being
--   iterated over between the lines in the layout, and returns the
--   space belonging to the current line. A line's range includes the
--   line's logical extents, plus half of the spacing above and below
--   the line, if 'pangoLayoutSetSpacing' has been called
--   to set layout spacing. The y positions are in layout coordinates
--   (origin at top left of the entire layout).
--
-- * The first element in the returned tuple is the start, the second is
--   the end of this line.
--
layoutIterGetLineYRange :: LayoutIter -> IO (Int,Int)
layoutIterGetLineYRange li = alloca $ \sPtr -> alloca $ \ePtr -> do
  {#call unsafe layout_iter_get_line_extents#} li (castPtr sPtr) (castPtr ePtr)
  start <- peek sPtr
  end <- peek ePtr
  return (start,end)

-- | Compute the physical size of the line.
--
-- * Computes the logical and the ink size of the line pointed to by
--   'LayoutIter'.
--
-- * Extents are in layout coordinates (origin is the top-left corner
--   of the entire 'PangoLayout'). Thus the extents returned
--   by this function will be the same width\/height but not at the
--   same x\/y as the extents returned from
--   'pangoLayoutLineGetExtents'.
--
layoutIterGetLineExtents :: LayoutIter -> IO (Rectangle, Rectangle)
layoutIterGetLineExtents li = alloca $ \logPtr -> alloca $ \inkPtr -> do
  {#call unsafe layout_iter_get_line_extents#} li (castPtr logPtr)
    (castPtr inkPtr)
  log <- peek logPtr
  ink <- peek inkPtr
  return (log,ink)


-- | Compute the physical size of the line.
--
-- * Computes the logical and the ink size of the 'LayoutLine'. The
--   logical layout is used for positioning, the ink size is the smallest
--   bounding box that includes all character pixels. The ink size can be
--   smaller or larger that the logical layout.
--
-- * All values are in layout units. To get to device units (pixel for
--   'Drawable's) divide by 'pangoScale'.
--
layoutLineGetExtents :: LayoutLine -> IO (Rectangle, Rectangle)
layoutLineGetExtents pl = alloca $ \logPtr -> alloca $ \inkPtr -> do
  {#call unsafe layout_line_get_extents#} pl (castPtr logPtr) (castPtr inkPtr)
  log <- peek logPtr
  ink <- peek inkPtr
  return (log,ink)

-- | Compute the physical size of the line.
--
-- * Computes the logical and the ink size of the 'LayoutLine'. The
--   logical layout is used for positioning, the ink size is the smallest
--   bounding box that includes all character pixels. The ink size can be
--   smaller or larger that the logical layout.
--
-- * All values are in device units. This function is a wrapper around
--   'layoutLineGetExtents' with scaling.
--
layoutLineGetPixelExtents :: LayoutLine -> IO (Rectangle, Rectangle)
layoutLineGetPixelExtents pl = alloca $ \logPtr -> alloca $ \inkPtr -> do
  {#call unsafe layout_line_get_pixel_extents#} pl
    (castPtr logPtr) (castPtr inkPtr)
  log <- peek logPtr
  ink <- peek inkPtr
  return (log,ink)


--- NEW FILE: Description.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) - text layout functions: Font Descriptions
--
--  Author : Axel Simon
--          
--  Created: 8 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:04 $
--
--  Copyright (c) 1999..2003 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.
--
-- |
--
-- Functions to manage font description.
--
-- * Font descriptions provide a way to query and state requirements of
--   fonts. This data structure has several fields describing different
--   characteristics of a font. Each of these fields can be set of left
--   unspecified.
--
module Graphics.UI.Gtk.Pango.Description (
  FontDescription,
  fontDescriptionNew,
  fontDescriptionCopy,
  fontDescriptionSetFamily,
  fontDescriptionGetFamily,
  fontDescriptionSetStyle,
  fontDescriptionGetStyle,
  fontDescriptionSetVariant,
  fontDescriptionGetVariant,
  fontDescriptionSetWeight,
  fontDescriptionGetWeight,
  fontDescriptionSetStretch,
  fontDescriptionGetStretch,
  fontDescriptionSetSize,
  fontDescriptionGetSize,
  fontDescriptionUnsetFields,
  fontDescriptionMerge,
  fontDescriptionBetterMatch,
  fontDescriptionFromString,
  fontDescriptionToString
  ) where

import Monad    (liftM)
import Data.Ratio

import System.Glib.FFI
import System.Glib.UTFString
{#import Graphics.UI.Gtk.Types#}
import System.Glib.GObject		(makeNewGObject)
{#import Graphics.UI.Gtk.Pango.Types#}
import Graphics.UI.Gtk.Pango.Enums
import Graphics.UI.Gtk.General.Enums
import Graphics.UI.Gtk.General.Structs	(pangoScale)

{# context lib="pango" prefix="pango_font_description" #}

-- | Create a new font description.
--
-- * All field are unset.
--
fontDescriptionNew :: IO FontDescription
fontDescriptionNew = {#call unsafe new#} >>= makeNewFontDescription 

-- | Make a deep copy of a font description.
--
fontDescriptionCopy :: FontDescription -> IO FontDescription
fontDescriptionCopy fd = {#call unsafe copy#} fd >>= makeNewFontDescription 

-- | Set the font famliy.
--
-- * A font family is a name designating the design of the font (e.g. Sans
--   or Times) without the variant.
--
-- * In some contexts a comma separated list of font families can be used.
--
fontDescriptionSetFamily :: FontDescription -> String -> IO ()
fontDescriptionSetFamily fd family = withUTFString family $ \strPtr ->
  {#call unsafe set_family_static#} fd strPtr

-- | Get the font family.
--
-- * 'Nothing' is returned if the font family is not set.
--
fontDescriptionGetFamily :: FontDescription -> IO (Maybe String)
fontDescriptionGetFamily fd = do
  strPtr <- {#call unsafe get_family#} fd
  if strPtr==nullPtr then return Nothing else
    liftM Just $ peekUTFString strPtr

-- Flags denoting which fields in a font description are set.
{#enum PangoFontMask as FontMask {underscoreToCase} deriving(Bounded) #}

instance Flags FontMask

-- | Set the style field.
--
-- * Most fonts will have either a 'StyleItalic' or 'StyleQblique'
--   but rarely both.
--
fontDescriptionSetStyle :: FontDescription -> FontStyle -> IO ()
fontDescriptionSetStyle fd p =
    {#call unsafe set_style#} fd (fromIntegral (fromEnum p))

-- | Get the style field.
fontDescriptionGetStyle :: FontDescription -> IO (Maybe FontStyle)
fontDescriptionGetStyle fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskStyle) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_style#} fd
     else return Nothing

-- | Set the variant field.
--
fontDescriptionSetVariant :: FontDescription -> Variant -> IO ()
fontDescriptionSetVariant fd p =
    {#call unsafe set_variant#} fd (fromIntegral (fromEnum p))

-- | Get the variant field.
fontDescriptionGetVariant :: FontDescription -> IO (Maybe Variant)
fontDescriptionGetVariant fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskVariant) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_variant#} fd
     else return Nothing

-- | Set the weight field.
--
fontDescriptionSetWeight :: FontDescription -> Weight -> IO ()
fontDescriptionSetWeight fd p =
  {#call unsafe set_weight#} fd (fromIntegral (fromEnum p))

-- | Get the weight field.
fontDescriptionGetWeight :: FontDescription -> IO (Maybe Weight)
fontDescriptionGetWeight fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskWeight) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      {#call unsafe get_weight#} fd
     else return Nothing

-- | Set the stretch field.
--
fontDescriptionSetStretch :: FontDescription -> Stretch -> IO ()
fontDescriptionSetStretch fd p =
  {#call unsafe set_stretch#} fd (fromIntegral (fromEnum p))

-- | Get the stretch field.
fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch)
fontDescriptionGetStretch fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskStretch) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $ 
	      {#call unsafe get_stretch#} fd
     else return Nothing

-- | Set the size field.
--
-- * The given size is in points (pts). One point is 1/72 inch.
--
fontDescriptionSetSize :: FontDescription -> Rational -> IO ()
fontDescriptionSetSize fd p = 
  {#call unsafe set_size#} fd (round (p*fromIntegral pangoScale))

-- | Get the size field.
fontDescriptionGetSize :: FontDescription -> IO (Maybe Rational)
fontDescriptionGetSize fd = do
  fields <- {#call unsafe get_set_fields#} fd
  if (fromEnum PangoFontMaskSize) .&. (fromIntegral fields) /=0
     then liftM (\x -> Just (fromIntegral x % pangoScale)) $ 
	      {#call unsafe get_size#} fd
     else return Nothing

-- | Reset fields in a font description.
--
fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO ()
fontDescriptionUnsetFields fd mask =
  {#call unsafe unset_fields#} fd (fromIntegral (fromFlags mask))

-- | Merge two font descriptions.
--
-- * Copy fields from the second description to the first. If the boolean
--   parameter is set, existing fields in the first description will be
--   replaced.
--
fontDescriptionMerge :: FontDescription -> FontDescription -> Bool -> IO ()
fontDescriptionMerge fd1 fd2 replace =
  {#call unsafe merge#} fd1 fd2 (fromBool replace)

-- | Determine if two descriptions are simliar.
--
-- * Returns 'True' if the two descriptions only differ in weight or style.
--
fontDescriptionIsMatch :: FontDescription -> FontDescription -> Bool
fontDescriptionIsMatch fdA fdB = unsafePerformIO $ liftM toBool $
  {#call unsafe better_match#} fdA (FontDescription nullForeignPtr) fdB

-- | Determine which of two descriptions matches a given description better.
--
-- * Returns 'True' if the last description is a better match to the first
--   arguement than the middle one.
--
-- * Approximate matching is done on weight and style. If the other
--   attributes do not match, the function returns 'False'.
--
fontDescriptionBetterMatch :: FontDescription -> FontDescription -> 
			      FontDescription -> Bool
fontDescriptionBetterMatch fd fdA fdB = unsafePerformIO $ liftM toBool $
  {#call unsafe better_match#} fd fdA fdB

-- | Create a font description from a string.
--
-- * The given argument must have the form 
--   "[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]" where FAMILY_LIST is a comma
--   separated list of font families optionally terminated by a comma,
--   STYLE_OPTIONS is a whitespace separated list of words where each
--   word describes one of style, variant, weight or stretch. SIZE is
--   a decimal number giving the size of the font in points. If any of
--   these fields is absent, the resulting 'FontDescription' will have
--   the corresponing fields unset.
--
fontDescriptionFromString :: String -> IO FontDescription
fontDescriptionFromString descr = withUTFString descr $ \strPtr ->
  {#call unsafe from_string#} strPtr >>= makeNewFontDescription

-- | Convert a font description to a string.
--
-- * Creates a string representation of a font description. See
--   'fontDescriptionFromString' for the format of the string.
--
fontDescriptionToString :: FontDescription -> IO String
fontDescriptionToString fd = do
  strPtr <- {#call unsafe to_string#} fd
  str <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Ornaments Frame.chs,NONE,1.1 HSeparator.chs,NONE,1.1 VSeparator.chs,NONE,1.1

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

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

Added Files:
	Frame.chs HSeparator.chs VSeparator.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Frame.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Frame
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:30:19 $
--
--  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 container adds a frame around its contents. This is useful to
-- logically separate items in a dialog box.
--

module Graphics.UI.Gtk.Ornaments.Frame (
  Frame,
  FrameClass,
  castToFrame,
  frameNew,
  frameSetLabel,
  frameGetLabel,
  frameSetLabelWidget,
  frameGetLabelWidget,
  frameSetLabelAlign,
  frameGetLabelAlign,
  ShadowType(..),
  frameSetShadowType,
  frameGetShadowType
  ) 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	(ShadowType(..))

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

-- methods

-- | Create a new frame without a label.
--
-- * A label can later be set by calling 'frameSetLabel'.
--
frameNew :: IO Frame
frameNew  = makeNewObject mkFrame $
  liftM castPtr $ {#call unsafe frame_new#} nullPtr

-- | Replace the label of the frame.
--
frameSetLabel :: FrameClass f => f -> String -> IO ()
frameSetLabel f label = withUTFString label $ \strPtr ->
  {#call frame_set_label#} (toFrame f) strPtr

-- | Replace the label with a (label) widget.
--
frameSetLabelWidget :: (FrameClass f, WidgetClass w) => f -> w -> IO ()
frameSetLabelWidget f w = 
  {#call frame_set_label_widget#} (toFrame f) (toWidget w)

-- | Get the label widget for the frame.
--
frameGetLabelWidget :: FrameClass f => f -> IO (Maybe Widget)
frameGetLabelWidget f = do
  widgetPtr <- {#call frame_get_label_widget#} (toFrame f)
  if widgetPtr == nullPtr
    then return Nothing
    else liftM Just $ makeNewObject mkWidget (return widgetPtr)

-- | Specify where the label should be placed.
--
-- * A value of 0.0 means left justified (the default), a value of 1.0 means
--   right justified.
--
frameSetLabelAlign :: FrameClass f => f -> Float -> IO ()
frameSetLabelAlign f align =
  {#call frame_set_label_align#} (toFrame f) (realToFrac align) 0.0

-- | Get the label's horazontal alignment.
--
frameGetLabelAlign :: FrameClass f => f -> IO Float
frameGetLabelAlign f =
  alloca $ \alignPtr -> do
  {#call unsafe frame_get_label_align#} (toFrame f) alignPtr nullPtr
  align <- peek alignPtr
  return (realToFrac align)

-- | Set the shadow type of the frame.
--
frameSetShadowType :: FrameClass f => f -> ShadowType -> IO ()
frameSetShadowType f shadow = 
  {#call frame_set_shadow_type#} (toFrame f) ((fromIntegral.fromEnum) shadow)

-- | Set the shadow type of the frame.
--
frameGetShadowType :: FrameClass f => f -> IO ShadowType
frameGetShadowType f = liftM (toEnum.fromIntegral) $
  {#call unsafe frame_get_shadow_type#} (toFrame f)

-- | Retrieve the label of the frame.
--
-- * An exception is thrown if a non-Label widget was set.
--
frameGetLabel :: FrameClass f => f -> IO String
frameGetLabel f = do
  strPtr <- throwIfNull 
    "frameGetLabel: the title of the frame was not a Label widget." $
    {#call unsafe frame_get_label#} (toFrame f)
  res <- peekUTFString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return res


   

--- NEW FILE: HSeparator.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget HSeparator
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:30:19 $
--
--  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 HSeparator widget is a horizontal separator, used to group the 
-- widgets within a window. It displays a horizontal line with a shadow 
-- to make it appear sunken into the interface.
--
-- * This has nothing to do with a menu separator.
--

module Graphics.UI.Gtk.Ornaments.HSeparator (
  HSeparator,
  HSeparatorClass,
  castToHSeparator,
  hSeparatorNew
  ) where

import Monad	(liftM)

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

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

-- methods

hSeparatorNew :: IO HSeparator
hSeparatorNew = makeNewObject mkHSeparator $ 
  liftM castPtr {#call unsafe hseparator_new#}

--- NEW FILE: VSeparator.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget VSeparator
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:30:19 $
--
--  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 VSeparator widget is a horizontal separator, used to group the 
-- widgets within a window. It displays a horizontal line with a shadow 
-- to make it appear sunken into the interface.
--
-- * This has nothing to do with a menu separator.
--

module Graphics.UI.Gtk.Ornaments.VSeparator (
  VSeparator,
  VSeparatorClass,
  castToVSeparator,
  vSeparatorNew
  ) where

import Monad	(liftM)

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

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

-- methods

vSeparatorNew :: IO VSeparator
vSeparatorNew = makeNewObject mkVSeparator $ 
  liftM castPtr {#call unsafe vseparator_new#}

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Multiline TextBuffer.chs,NONE,1.1 TextMark.chs,NONE,1.1 TextTagTable.chs,NONE,1.1

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

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

Added Files:
	TextBuffer.chs TextMark.chs TextTagTable.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: TextMark.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TextMark TextBuffer
--
--  Author : Axel Simon
--          
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:29:36 $
--
--  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.
--
-- |
--

module Graphics.UI.Gtk.Multiline.TextMark (
  TextMark,
  TextMarkClass,
  castToTextMark,
  MarkName,
  textMarkSetVisible,
  textMarkGetVisible,
  textMarkGetDeleted,
  textMarkGetName,
  textMarkGetBuffer,
  textMarkGetLeftGravity
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject	(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

type MarkName = String

-- methods

-- | Set the visibility of a 'TextMark'.
--
textMarkSetVisible :: TextMarkClass tm => tm -> Bool -> IO ()
textMarkSetVisible tm vis = 
  {#call unsafe text_mark_set_visible#} (toTextMark tm) (fromBool vis)


-- | Get the visibility of a 'TextMark'.
--
textMarkGetVisible :: TextMarkClass tm => tm -> IO Bool
textMarkGetVisible tm = liftM toBool $
  {#call unsafe text_mark_get_visible#} (toTextMark tm)

-- | Query if a 'TextMark' is still valid.
--
textMarkGetDeleted :: TextMarkClass tm => tm -> IO Bool
textMarkGetDeleted tm = liftM toBool $
  {#call unsafe text_mark_get_deleted#} (toTextMark tm)

-- | Get the name of a 'TextMark'.
--
-- * Returns Nothing, if the mark is anonymous.
--
textMarkGetName :: TextMarkClass tm => tm -> IO (Maybe String)
textMarkGetName tm = do
  strPtr <- {#call unsafe text_mark_get_name#} (toTextMark tm)
  if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr

-- | Extract the 'TextBuffer' of the mark.
--
-- * Returns Nothing if the mark was deleted.
--
textMarkGetBuffer :: TextMarkClass tm => tm -> IO (Maybe TextBuffer)
textMarkGetBuffer tm = do
  bufPtr <- {#call unsafe text_mark_get_buffer#} (toTextMark tm)
  if bufPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkTextBuffer (return $ castPtr bufPtr)

-- | Determine whether the mark has gravity
-- towards the beginning of a line.
--
-- * The name is misleading as Arabic, Hebrew and some other languages have
--   the beginning of a line towards the right.
--
textMarkGetLeftGravity :: TextMarkClass tm => tm -> IO Bool
textMarkGetLeftGravity tm = liftM toBool $
  {#call unsafe text_mark_get_left_gravity#} (toTextMark tm)


 

--- NEW FILE: TextTagTable.chs ---
{-# OPTIONS -cpp #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget TextTagTable
--
--  Author : Duncan Coutts
--  Created: 4 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--

module Graphics.UI.Gtk.Multiline.TextTagTable  (
  TextTagTable,
  TextTagTableClass,
  castToTextTagTable,
  textTagTableNew,
  textTagTableAdd,
  textTagTableRemove,
  textTagTableLookup,
  textTagTableForeach,
  textTagTableGetSize
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GObject	(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

-- | Creates a new 'TextTagTable'. The table contains no tags by default.
--
textTagTableNew :: IO TextTagTable
textTagTableNew =
  makeNewGObject mkTextTagTable $ 
  {#call unsafe text_tag_table_new#}

-- | Add a tag to the table. The tag is assigned the highest priority in the
-- table.
--
-- The tag must not be in a tag table already, and may not have the same name as
-- an already-added tag.
--
textTagTableAdd :: TextTagTableClass obj => obj -> TextTag -> IO ()
textTagTableAdd obj tag =
  {#call text_tag_table_add#} (toTextTagTable obj) tag

-- | Remove a tag from the table.
--
textTagTableRemove :: TextTagTableClass obj => obj -> TextTag -> IO ()
textTagTableRemove obj tag =
  {#call text_tag_table_remove#} (toTextTagTable obj) tag

-- | Look up a named tag.
--
textTagTableLookup :: TextTagTableClass obj => obj
                   -> String -> IO (Maybe TextTag)
textTagTableLookup obj name =
  withCString name $ \strPtr -> do
  tagPtr <- {#call unsafe text_tag_table_lookup#} (toTextTagTable obj) strPtr
  if tagPtr == nullPtr then return Nothing else liftM Just $
    makeNewGObject mkTextTag (return tagPtr)

-- | Calls func on each tag in table.
--
textTagTableForeach :: TextTagTableClass obj => obj
                    -> (TextTag -> IO ()) -> IO ()
textTagTableForeach obj func = do
  funcPtr <- mkTextTagTableForeach (\tagPtr _ -> do
    tag <- makeNewGObject mkTextTag (return tagPtr)
    func tag)
  {#call text_tag_table_foreach#} (toTextTagTable obj) funcPtr nullPtr

{#pointer TextTagTableForeach#}

foreign import ccall "wrapper" mkTextTagTableForeach ::
  (Ptr TextTag -> Ptr () -> IO ()) -> IO TextTagTableForeach

-- | Returns the size of the table (the number of tags).
--
textTagTableGetSize :: TextTagTableClass obj => obj -> IO Int
textTagTableGetSize obj = liftM fromIntegral $
  {#call unsafe text_tag_table_get_size#} (toTextTagTable obj)

--- NEW FILE: TextBuffer.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TextBuffer
--
--  Author : Axel Simon
--          
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:29:36 $
--
--  Copyright (c) [2001..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 storage object holds text to be displayed by one or more 
-- 'TextView' widgets.
--
-- * See \"Text Widget Overview\" in the Gtk+ docs.
--
-- * The following convenience functions are omitted: 
--     gtk_text_buffer_insert_with_tags
--     gtk_text_buffer_insert_with_tags_by_name
--     gtk_text_buffer_create_tag
--     gtk_text_buffer_get_bounds
--     gtk_text_buffer_get_selection_bounds
--
-- * The following functions do not make sense due to Haskell's wide character
--   representation of Unicode:
--     gtk_text_buffer_get_iter_at_line_index
--
-- * The function gtk_text_buffer_get_selection_bounds is only used to test
--   if there is a selection  (see 'textBufferHasSelection').
--
-- TODO
--
-- * The functionality of inserting widgets (child anchors) is not implemented
--   since there will probably some changes before the final release. The
--   following functions are not bound:
--     gtk_text_buffer_insert_child_anchor
--     gtk_text_buffer_create_child_anchor
--     gtk_text_buffer_get_iter_at_anchor
--     connectToInsertChildAnchor
--     
-- * Check 'textBufferGetInsert', in case there is no cursor in 
--   the editor,
--   is there a mark called \"insert\"? If not, the function needs to return
--   Maybe TextMark. The same holds for 
--   'textBufferGetSelectionBound'.
--
-- * If Clipboards are bound, then these functions need to be bound as well:
--     gtk_text_buffer_paste_clipboard
--     gtk_text_buffer_copy_clipboard
--     gtk_text_buffer_cut_clipboard
--     gtk_text_buffer_add_selection_clipboard
--     gtk_text_buffer_remove_selection_clipboard
--
module Graphics.UI.Gtk.Multiline.TextBuffer (
  TextBuffer,
  TextBufferClass,
  castToTextBuffer,
  textBufferNew,
  textBufferGetLineCount,
  textBufferGetCharCount,
  textBufferGetTagTable,
  textBufferInsert,
  textBufferInsertAtCursor,
  textBufferInsertInteractive,
  textBufferInsertInteractiveAtCursor,
  textBufferInsertRange,
  textBufferInsertRangeInteractive,
  textBufferDelete,
  textBufferDeleteInteractive,
  textBufferSetText,
  textBufferGetText,
  textBufferGetSlice,
  textBufferInsertPixbuf,
  textBufferCreateMark,
  textBufferMoveMark,
  textBufferMoveMarkByName,
  textBufferDeleteMark,
  textBufferDeleteMarkByName,
  textBufferGetMark,
  textBufferGetInsert,
  textBufferGetSelectionBound,
  textBufferPlaceCursor,
  textBufferApplyTag,
  textBufferRemoveTag,
  textBufferApplyTagByName,
  textBufferRemoveTagByName,
  textBufferRemoveAllTags,
  textBufferGetIterAtLineOffset,
  textBufferGetIterAtOffset,
  textBufferGetIterAtLine,
  textBufferGetIterAtMark,
  textBufferGetStartIter,
  textBufferGetEndIter,
  textBufferGetModified,
  textBufferSetModified,
  textBufferDeleteSelection,
  textBufferHasSelection,
  textBufferBeginUserAction,
  textBufferEndUserAction,
  onApplyTag, afterApplyTag,
  onBeginUserAction, afterBeginUserAction,
  onBufferChanged, afterBufferChanged,
  onDeleteRange, afterDeleteRange,
  onEndUserAction, afterEndUserAction,
  onInsertPixbuf, afterInsertPixbuf,
  onInsertText, afterInsertText,
  onMarkDeleted, afterMarkDeleted,
  onMarkSet, afterMarkSet,
  onModifiedChanged, afterModifiedChanged,
  onRemoveTag, afterRemoveTag,
  
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject			(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.Multiline.TextIter#}
import Graphics.UI.Gtk.Multiline.TextMark	(TextMark, MarkName)
import Graphics.UI.Gtk.Multiline.TextTag	(TextTag, TagName)

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

-- methods

-- | Create a new text buffer, possibly taking a
-- table of 'TextTag'.
--
textBufferNew :: Maybe TextTagTable -> IO TextBuffer
textBufferNew tt = makeNewGObject mkTextBuffer $ liftM castPtr $
  {#call unsafe text_buffer_new#} 
  (fromMaybe (mkTextTagTable nullForeignPtr) tt)

-- | Obtain the number of lines in the buffer.
--
textBufferGetLineCount :: TextBufferClass tb => tb -> IO Int
textBufferGetLineCount tb = liftM fromIntegral $ 
  {#call unsafe text_buffer_get_line_count#} (toTextBuffer tb)

-- | Obtain the number of characters in the
-- buffer.
--
-- * Note that the comment in the Gtk+ documentation about bytes and chars
--   does not hold because Haskell uses 31-bit characters and not UTF8.
--
textBufferGetCharCount :: TextBufferClass tb => tb -> IO Int
textBufferGetCharCount tb = liftM fromIntegral $
  {#call unsafe text_buffer_get_char_count#} (toTextBuffer tb)

-- | Extract the tag table that is associated
-- with this text buffer.
--
textBufferGetTagTable :: TextBufferClass tb => tb -> IO TextTagTable
textBufferGetTagTable tb = makeNewGObject mkTextTagTable $ liftM castPtr $
  {#call unsafe text_buffer_get_tag_table#} (toTextBuffer tb)

-- | Insert text at the position specified by the
-- 'TextIter'.
--
textBufferInsert :: TextBufferClass tb => tb -> TextIter -> String -> IO ()
textBufferInsert tb iter str = withUTFStringLen str $ \(cStr, len) ->
  {#call text_buffer_insert#} (toTextBuffer tb) iter cStr (fromIntegral len)

-- | Insert text at the cursor.
--
textBufferInsertAtCursor :: TextBufferClass tb => tb -> String -> IO ()
textBufferInsertAtCursor tb str = withUTFStringLen str $ \(cStr, len) ->
  {#call text_buffer_insert_at_cursor#} (toTextBuffer tb) cStr
    (fromIntegral len)

-- | Insert text at the 'TextIter'
-- only if a normal user would be able to do so as well.
--
-- * Insert the text obeying special editable or non-editable Tags.
--
-- * If no tag is at the specified position, use the default value
--   @def@ to decide if the text should be inserted. This value could
--   be set to the result of 'textViewGetEditable'.
--
textBufferInsertInteractive :: TextBufferClass tb => tb -> TextIter ->
						     String -> Bool ->
                               			     IO Bool
textBufferInsertInteractive tb iter str def = withUTFStringLen str $ 
  \(cStr, len) -> liftM toBool $ {#call text_buffer_insert_interactive#} 
    (toTextBuffer tb) iter cStr (fromIntegral len) (fromBool def)

-- | Insert text at cursor only if
-- a normal user would be able to do so as well.
--
textBufferInsertInteractiveAtCursor :: TextBufferClass tb => tb -> String ->
							     Bool -> IO Bool
textBufferInsertInteractiveAtCursor tb str def = withUTFStringLen str $ 
  \(cStr, len) -> liftM toBool $ 
  {#call text_buffer_insert_interactive_at_cursor #} (toTextBuffer tb) cStr 
    (fromIntegral len) (fromBool def)

-- | Copy text between the two
-- 'TextIter' @start@ and @end@ to another location
-- @ins@.
--

--
textBufferInsertRange :: TextBufferClass tb => tb -> TextIter -> TextIter ->
					       TextIter -> IO ()
textBufferInsertRange tb ins start end = {#call text_buffer_insert_range#}
  (toTextBuffer tb) ins start end

-- | Copy text as
-- 'textBufferInsertRange' does, but obey editable and non-editable
-- tags.
--
-- * Insert the text obeying special editable or non-editable Tags.
--
-- * If no tag is at the specified position, use the default value
--   @def@ to decide if the text should be inserted. This value could
--   be set to the result of 'textViewGetEditable'.
--
textBufferInsertRangeInteractive :: TextBufferClass tb => tb -> TextIter ->
				    TextIter -> TextIter -> Bool -> IO Bool
textBufferInsertRangeInteractive tb ins start end def = liftM toBool $
  {#call text_buffer_insert_range_interactive#} (toTextBuffer tb) ins start
    end (fromBool def)


-- | Delete some text.
--
textBufferDelete :: TextBufferClass tb => tb -> TextIter -> TextIter -> IO ()
textBufferDelete tb start end = {#call text_buffer_delete#} (toTextBuffer tb)
				start end

-- | Delete some text but obey editable and
-- non-editable tags.
--
textBufferDeleteInteractive :: TextBufferClass tb => tb -> TextIter ->
						     TextIter -> Bool ->
                               			     IO Bool
textBufferDeleteInteractive tb start end def = liftM toBool $
  {#call text_buffer_delete_interactive#} (toTextBuffer tb) start end
    (fromBool def)

-- | Replace the text in the current
-- 'TextBuffer'.
--
textBufferSetText :: TextBufferClass tb => tb -> String -> IO ()
textBufferSetText tb str = withUTFStringLen str $ \(cStr, len) ->
  {#call text_buffer_set_text#} (toTextBuffer tb) cStr (fromIntegral len)

-- | Extract all the text between @start@ and
-- @end@ from a 'TextBuffer'.
--
-- * The @start@ position is included, @end@ is not.
--
-- * If @incl@ is True, text tagged with the invisible attribute is
--   also returned.
--
-- * Characters representing embedded images are not included. (So offsets
--   within the returned text are different from the Buffer itself.)
--
textBufferGetText :: TextBufferClass tb => tb -> TextIter -> TextIter -> 
					   Bool -> IO String
textBufferGetText tb start end incl = {#call unsafe text_buffer_get_text#} 
  (toTextBuffer tb) start end (fromBool incl) >>= peekUTFString

-- | Extract text and special characters between
-- @start@ and @end@.
--
-- * As opposed to 'textBufferGetText', this function returns 
--   @(chr 0xFFFC)@ for images, so offsets within the returned 
--   string correspond to offsets in the 'TextBuffer'. Note the
--   @(chr 0xFFFC)@ can occur in normal text without images as well.
--
textBufferGetSlice :: TextBufferClass tb => tb -> TextIter -> TextIter ->
					    Bool -> IO String
textBufferGetSlice tb start end incl = {#call unsafe text_buffer_get_slice#}
  (toTextBuffer tb) start end (fromBool incl) >>= peekUTFString

-- | Insert an image into the
-- 'TextBuffer'.
--
-- * See 'textBufferGetSlice' and 'textBufferGetText'.
--
textBufferInsertPixbuf :: TextBufferClass tb => tb -> TextIter -> Pixbuf ->
						IO ()
textBufferInsertPixbuf tb pos img = 
  {#call text_buffer_insert_pixbuf#} (toTextBuffer tb) pos img

-- | Create a 'TextMark' from an
-- iterator.
--
-- * Pass @Nothing@ as mark name for an anonymous 
--   'TextMark'.
--
-- * Set @gravity@ to True if the mark should keep left.
--
textBufferCreateMark :: TextBufferClass tb => tb -> Maybe MarkName -> 
					      TextIter -> Bool ->
                        		      IO TextMark
textBufferCreateMark tb Nothing iter gravity = makeNewGObject mkTextMark $
  {#call unsafe text_buffer_create_mark#} (toTextBuffer tb) nullPtr iter
    (fromBool gravity)
textBufferCreateMark tb (Just name) iter gravity = 
  makeNewGObject mkTextMark $ withUTFString name $ \cStr ->
  {#call unsafe text_buffer_create_mark#} (toTextBuffer tb) cStr iter
    (fromBool gravity)

-- | Move a mark.
--
-- * Emits \"mark_set\".
--
textBufferMoveMark :: TextBufferClass tb => tb -> TextMark -> TextIter -> IO ()
textBufferMoveMark tb tm iter =
  {#call text_buffer_move_mark#} (toTextBuffer tb) tm iter

-- | Move a named mark.
--
-- * The mark should exist (otherwise a nasty warning is generated).
--
textBufferMoveMarkByName :: TextBufferClass tb => tb -> MarkName ->
						  TextIter -> IO ()
textBufferMoveMarkByName tb name iter = withUTFString name $ \cStr ->
  {#call text_buffer_move_mark_by_name#} (toTextBuffer tb) cStr iter

-- | Delete a mark.
--
-- * This renders the 'TextMark' @tm@ unusable forever.
--
textBufferDeleteMark :: TextBufferClass tb => tb -> TextMark -> IO ()
textBufferDeleteMark tb tm =
  {#call text_buffer_delete_mark#} (toTextBuffer tb) tm

-- | Delete a mark by name.
--
-- * The mark should exist (otherwise a nasty warning is generated).
--
textBufferDeleteMarkByName :: TextBufferClass tb => tb -> MarkName -> IO ()
textBufferDeleteMarkByName tb name = withUTFString name $ \cStr ->
  {#call text_buffer_delete_mark_by_name#} (toTextBuffer tb) cStr

-- | Retrieve a 'TextMark' by name.
--
textBufferGetMark :: TextBufferClass tb => tb -> MarkName ->
					   IO (Maybe TextMark)
textBufferGetMark tb name = do
  tm <- withUTFString name $ \cStr -> 
    {#call unsafe text_buffer_get_mark#} (toTextBuffer tb) cStr
  if tm==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkTextMark (return tm)

-- | Get the current cursor position.
--
-- * This is equivalent to liftM unJust $ textBufferGetMark \"insert\"
--
textBufferGetInsert :: TextBufferClass tb => tb -> IO TextMark
textBufferGetInsert tb = makeNewGObject mkTextMark $
  {#call unsafe text_buffer_get_insert#} (toTextBuffer tb)

-- | Get a 'TextMark' for the
-- other side of a selection.
--
textBufferGetSelectionBound :: TextBufferClass tb => tb -> IO TextMark
textBufferGetSelectionBound tb = makeNewGObject mkTextMark $
  {#call unsafe text_buffer_get_selection_bound#} (toTextBuffer tb)

-- | Place the cursor.
--
-- * This is faster than moving the \"insert\" and the \"selection_bound\" marks
--   in sequence since it avoids generating a transient selection.
--
textBufferPlaceCursor :: TextBufferClass tb => tb -> TextIter -> IO ()
textBufferPlaceCursor tb iter =
  {#call text_buffer_place_cursor#} (toTextBuffer tb) iter

-- | Tag a range of text.
--
textBufferApplyTag :: TextBufferClass tb => tb -> TextTag -> TextIter ->
						  TextIter -> IO ()
textBufferApplyTag tb tag start end = 
  {#call text_buffer_apply_tag#} (toTextBuffer tb) tag start end

-- | Remove a tag from a range of text.
--
textBufferRemoveTag :: TextBufferClass tb => tb -> TextTag -> TextIter ->
					     TextIter -> IO ()
textBufferRemoveTag tb tag start end =
  {#call text_buffer_remove_tag#} (toTextBuffer tb) tag start end

-- | Apply a tag that is specified by name.
--
textBufferApplyTagByName :: TextBufferClass tb => tb -> TagName ->
		      				  TextIter -> TextIter ->
                            			  IO () 
textBufferApplyTagByName tb tname start end = withUTFString tname $ \cStr ->
  {#call text_buffer_apply_tag_by_name#} (toTextBuffer tb) cStr start end

-- | Remove a tag from a range of text.
--
textBufferRemoveTagByName :: TextBufferClass tb => tb -> TagName -> 
						   TextIter -> TextIter ->
                             			   IO ()
textBufferRemoveTagByName tb tname start end = withUTFString tname $ \cStr ->
  {#call text_buffer_remove_tag_by_name#} (toTextBuffer tb) cStr start end

-- | Remove all tags within a range.
-- 
-- * Be careful with this function; it could remove tags added in code
--   unrelated to the code you're currently writing. That is, using this
--   function is probably a bad idea if you have two or more unrelated code
--   sections that add tags.
--

--
textBufferRemoveAllTags :: TextBufferClass tb => tb -> TextIter -> 
						 TextIter -> IO ()
textBufferRemoveAllTags tb start end =
  {#call text_buffer_remove_all_tags#} (toTextBuffer tb) start end

-- | Create an iterator at a specific
-- line and offset.
--
-- * The @line@ and @offset@ arguments must be valid.
--
textBufferGetIterAtLineOffset :: TextBufferClass tb => tb -> Int -> Int -> 
						       IO TextIter
textBufferGetIterAtLineOffset tb line offset = do
  iter <- makeEmptyTextIter
  {#call unsafe text_buffer_get_iter_at_line_offset#}
    (toTextBuffer tb) iter (fromIntegral line) (fromIntegral offset)
  return iter

-- | Create an iterator at a specific offset.
--
-- * The @offset@ arguments must be valid, starting from the first
--   character in the buffer.
--
textBufferGetIterAtOffset :: TextBufferClass tb => tb -> Int -> IO TextIter
textBufferGetIterAtOffset tb offset = do
  iter <- makeEmptyTextIter
  {#call unsafe text_buffer_get_iter_at_offset#}
    (toTextBuffer tb) iter (fromIntegral offset)
  return iter
  
-- | Create an iterator at a specific line.
--
-- * The @line@ arguments must be valid.
--
textBufferGetIterAtLine :: TextBufferClass tb => Int -> tb -> IO TextIter
textBufferGetIterAtLine line tb = do
  iter <- makeEmptyTextIter
  {#call unsafe text_buffer_get_iter_at_line#}
    (toTextBuffer tb) iter (fromIntegral line)
  return iter


-- | Create an iterator from a mark.
--
textBufferGetIterAtMark :: TextBufferClass tb => tb -> TextMark -> IO TextIter
textBufferGetIterAtMark tb tm = do
  iter <- makeEmptyTextIter
  {#call unsafe text_buffer_get_iter_at_mark#} (toTextBuffer tb) iter tm
  return iter


-- | Create an iterator at the beginning of the
-- buffer.
--
textBufferGetStartIter :: TextBufferClass tb => tb -> IO TextIter
textBufferGetStartIter tb = do
  iter <- makeEmptyTextIter
  {#call unsafe text_buffer_get_start_iter#} (toTextBuffer tb) iter
  return iter

-- | Create an iterator at the end of the buffer.
--
-- * The iterator represents the position after the last character in the
--   buffer.
--
textBufferGetEndIter :: TextBufferClass tb => tb -> IO TextIter
textBufferGetEndIter tb = do
  iter <- makeEmptyTextIter
  {#call unsafe text_buffer_get_end_iter#} (toTextBuffer tb) iter
  return iter


-- | Query if the buffer was modified.
--
-- * This flag is reset by calling 'textBufferSetModified'.
--
-- * It is usually more convenient to use
--   @\"connectToModifiedChanged\"@.
--
textBufferGetModified :: TextBufferClass tb => tb -> IO Bool
textBufferGetModified tb = liftM toBool $
  {#call unsafe text_buffer_get_modified#} (toTextBuffer tb)

-- | Set the \"buffer-is-modified\" flag.
--
textBufferSetModified :: TextBufferClass tb => tb -> Bool -> IO ()
textBufferSetModified tb isModified =
  {#call text_buffer_set_modified#} (toTextBuffer tb) (fromBool isModified)

-- | Delete the current selection.
--
-- * The @interactive@ flag determines if this function is invoked on
--   behalf of the user (i.e. if we honour editable\/non-editable tags).
--
-- * See 'textBufferInsertAtCursor' for information on
--   @def@.
--
-- * The function returns True if a non-empty selection was deleted.
--
textBufferDeleteSelection :: TextBufferClass tb => tb -> Bool -> Bool ->
						   IO Bool
textBufferDeleteSelection tb interactive def = liftM toBool $
  {#call text_buffer_delete_selection#} (toTextBuffer tb)
  (fromBool interactive) (fromBool def)

-- | Check if a selection exists.
--
textBufferHasSelection :: TextBufferClass tb => tb -> IO Bool
textBufferHasSelection tb = liftM toBool $
  {#call unsafe text_buffer_get_selection_bounds#} 
  (toTextBuffer tb) (TextIter nullForeignPtr) (TextIter nullForeignPtr)

-- | Start a new atomic user action.
--
-- * Called to indicate that the buffer operations between here and a call to
--   'textBufferEndUserAction' are part of a single user-visible
--   operation. The operations between 'textBufferBeginUserAction'
--   and 'textBufferEndUserAction' can then be grouped when
--   creating an undo stack. 'TextBuffer' objects maintains a count
--   of calls to 'textBufferBeginUserAction' that have not been
--   closed with a call to 'textBufferEndUserAction', and emits the
--   \"begin_user_action\" and \"end_user_action\" signals only for the outermost
--   pair of calls. This allows you to build user actions from other user
--   actions. The \"interactive\" buffer mutation functions, such as
--   'textBufferInsertInteractive', automatically call begin\/end
--   user action around the buffer operations they perform, so there's no need
--   to add extra calls if you user action consists solely of a single call to
--   one of those functions.
--
textBufferBeginUserAction :: TextBufferClass tb => tb -> IO ()
textBufferBeginUserAction  = {#call text_buffer_begin_user_action#} .
			     toTextBuffer

-- | End an atomic user action.
--
textBufferEndUserAction :: TextBufferClass tb => tb -> IO ()
textBufferEndUserAction  = {#call text_buffer_end_user_action#} .
			   toTextBuffer


-- callbacks

-- | A 'TextTag' was applied to a region of
-- text.
--
onApplyTag, afterApplyTag :: TextBufferClass tb => tb ->
                             (TextTag -> TextIter -> TextIter -> IO ()) ->
                             IO (ConnectId tb)
onApplyTag = connect_OBJECT_BOXED_BOXED__NONE "apply-tag" 
  mkTextIter mkTextIter False
afterApplyTag = connect_OBJECT_BOXED_BOXED__NONE "apply-tag" 
  mkTextIter mkTextIter True

-- | A new atomic user action is started.
--
-- * Together with 'connectToEndUserAction' these signals can be
--   used to build an undo stack.
--
onBeginUserAction, afterBeginUserAction :: TextBufferClass tb => tb -> IO () ->
                                           IO (ConnectId tb)
onBeginUserAction = connect_NONE__NONE "begin_user_action" False
afterBeginUserAction = connect_NONE__NONE "begin_user_action" True

--- renamed from Changed to BufferChanged, since the former conflicts with TreeSelection
-- | Emitted when the contents of the buffer change.
--
onBufferChanged, afterBufferChanged :: TextBufferClass tb => tb -> IO () ->
                           IO (ConnectId tb)
onBufferChanged = connect_NONE__NONE "changed" False
afterBufferChanged = connect_NONE__NONE "changed" True

-- | A range of text is about to be deleted.
--
onDeleteRange, afterDeleteRange :: TextBufferClass tb => tb ->
                                   (TextIter -> TextIter -> IO ()) ->
                                   IO (ConnectId tb)
onDeleteRange = connect_BOXED_BOXED__NONE "delete_range"
  mkTextIter mkTextIter False
afterDeleteRange = connect_BOXED_BOXED__NONE "delete_range"
  mkTextIter mkTextIter True

-- | An atomic action has ended.
--
-- * see 'connectToBeginUserAction'
--
onEndUserAction, afterEndUserAction :: TextBufferClass tb => tb -> IO () ->
                                       IO (ConnectId tb)
onEndUserAction = connect_NONE__NONE "end_user_action" False
afterEndUserAction = connect_NONE__NONE "end_user_action" True

-- | A widgets is inserted into the buffer.
--connectToInsertChildAnchor :: TextBufferClass tb =>
-- (TextIter -> TextChildAnchor -> IO ()) -> ConnectAfter -> tb -> 
--  IO (ConnectId tb)
--connectToInsertChildAnchor = connect_BOXED_OBJECT__NONE "insert_child_anchor"
--  mkTextIter

-- | A 'Pixbuf' is inserted into the
-- buffer.
--
onInsertPixbuf, afterInsertPixbuf :: TextBufferClass tb => tb ->
                                     (TextIter -> Pixbuf -> IO ()) ->
                                     IO (ConnectId tb)
onInsertPixbuf = connect_BOXED_OBJECT__NONE "insert_pixbuf" mkTextIter False
afterInsertPixbuf = connect_BOXED_OBJECT__NONE "insert_pixbuf" mkTextIter True

-- | Some text was inserted.
--
onInsertText, afterInsertText :: TextBufferClass tb => tb ->
                                 (TextIter -> String -> IO ()) ->
                                 IO (ConnectId tb)
onInsertText tb user = 
  connect_BOXED_PTR_INT__NONE "insert_text" mkTextIter False tb $
    \iter strP strLen -> do
      str <- peekUTFStringLen (strP,strLen)
      user iter str 
afterInsertText tb user = 
  connect_BOXED_PTR_INT__NONE "insert_text" mkTextIter True tb $
    \iter strP strLen -> do
      str <- peekUTFStringLen (strP,strLen)
      user iter str 

-- | A 'TextMark' within the buffer was
-- deleted.
--
onMarkDeleted, afterMarkDeleted :: TextBufferClass tb => tb ->
                                   (TextMark -> IO ()) -> IO (ConnectId tb)
onMarkDeleted = connect_OBJECT__NONE "mark_deleted" False
afterMarkDeleted = connect_OBJECT__NONE "mark_deleted" True

-- | A 'TextMark' was inserted into the
-- buffer.
--
onMarkSet, afterMarkSet :: TextBufferClass tb => tb ->
                           (TextIter -> TextMark -> IO ()) ->
                           IO (ConnectId tb)
onMarkSet = connect_BOXED_OBJECT__NONE "mark_set" mkTextIter False
afterMarkSet = connect_BOXED_OBJECT__NONE "mark_set" mkTextIter True

-- | The textbuffer has changed.
--
onModifiedChanged, afterModifiedChanged :: TextBufferClass tb => tb -> IO () ->
                                           IO (ConnectId tb)
onModifiedChanged = connect_NONE__NONE "modified_changed" False
afterModifiedChanged = connect_NONE__NONE "modified_changed" True

-- | A 'TextTag' was removed.
--
onRemoveTag, afterRemoveTag :: TextBufferClass tb => tb ->
                               (TextTag -> TextIter -> TextIter -> IO ()) ->
                               IO (ConnectId tb)
onRemoveTag = connect_OBJECT_BOXED_BOXED__NONE "remove_tag" 
  mkTextIter mkTextIter False
afterRemoveTag = connect_OBJECT_BOXED_BOXED__NONE "remove_tag" 
  mkTextIter mkTextIter True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Multiline TextView.chs,NONE,1.1

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

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

Added Files:
	TextView.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: TextView.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget TextView
--
--  Author : Axel Simon
--          
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:29:21 $
--
--  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.
--
-- |
--
-- * Throughout we distinguish between buffer coordinates which are pixels
--   with the origin at the upper left corner of the first character on the
--   first line. Window coordinates are relative to the top left pixel which
--   is visible in the current 'TextView'. Coordinates from Events 
--   are in the latter relation. The conversion can be done with 
--   'textViewWindowToBufferCoords'.
--
-- TODO
--
-- * If PangoTabArray is bound: do textViewSetTabs and textViewGetTabs
--
module Graphics.UI.Gtk.Multiline.TextView (
  TextView,
  TextViewClass,
  TextChildAnchor,
  TextChildAnchorClass,
  castToTextView,
  DeleteType(..),
  DirectionType(..),
  Justification(..),
  MovementStep(..),
  TextWindowType(..),
  WrapMode(..),
  textViewNew,
  textViewNewWithBuffer,
  textViewSetBuffer,
  textViewGetBuffer,
  textViewScrollToMark,
  textViewScrollToIter,
  textViewScrollMarkOnscreen,
  textViewMoveMarkOnscreen,
  textViewPlaceCursorOnscreen,
  textViewGetLineAtY,
  textViewGetLineYrange,
  textViewGetIterAtLocation,
  textViewBufferToWindowCoords,
  textViewWindowToBufferCoords,
  textViewGetWindow,
  textViewGetWindowType,
  textViewSetBorderWindowSize,
  textViewGetBorderWindowSize,
  textViewForwardDisplayLine,
  textViewBackwardDisplayLine,
  textViewForwardDisplayLineEnd,
  textViewBackwardDisplayLineEnd,
  textViewForwardDisplayLineStart,
  textViewBackwardDisplayLineStart,
  textViewStartsDisplayLine,
  textViewMoveVisually,
  textViewAddChildAtAnchor,
  textChildAnchorNew,
  textChildAnchorGetWidgets,
  textChildAnchorGetDeleted,
  textViewAddChildInWindow,
  textViewMoveChild,
  textViewSetWrapMode,
  textViewGetWrapMode,
  textViewSetEditable,
  textViewGetEditable,
  textViewSetCursorVisible,
  textViewGetCursorVisible,
  textViewSetPixelsAboveLines,
  textViewGetPixelsAboveLines,
  textViewSetPixelsBelowLines,
  textViewGetPixelsBelowLines,
  textViewSetPixelsInsideWrap,
  textViewGetPixelsInsideWrap,
  textViewSetJustification,
  textViewGetJustification,
  textViewSetLeftMargin,
  textViewGetLeftMargin,
  textViewSetRightMargin,
  textViewGetRightMargin,
  textViewSetIndent,
  textViewGetIndent,
  textViewGetDefaultAttributes,
  onCopyClipboard,
  afterCopyClipboard,
  onCutClipboard,
  afterCutClipboard,
  onDeleteFromCursor,
  afterDeleteFromCursor,
  onInsertAtCursor,
  afterInsertAtCursor,
  onMoveCursor,
  afterMoveCursor,
  onMoveFocus,
  afterMoveFocus,
  onPageHorizontally,
  afterPageHorizontally,
  onPasteClipboard,
  afterPasteClipboard,
  onPopulatePopup,
  afterPopulatePopup,
  onSetAnchor,
  afterSetAnchor,
  onSetScrollAdjustments,
  afterSetScrollAdjustments,
  onToggleOverwrite,
  afterToggleOverwrite) 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.Multiline.TextIter#}
{#import Graphics.UI.Gtk.Multiline.TextTag#}
import Graphics.UI.Gtk.General.Enums	(TextWindowType(..), DeleteType(..),
					 DirectionType(..), Justification(..),
					 MovementStep(..), WrapMode(..))
import System.Glib.GList		(fromGList)
import Graphics.UI.Gtk.General.Structs	(Rectangle(..))

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


-- methods

-- | Create a new 'TextView' widget with a
-- default 'TextBuffer'.
--
textViewNew :: IO TextView
textViewNew  = makeNewGObject mkTextView $ liftM castPtr 
  {#call unsafe text_view_new#}

-- | Create a new 'TextView' widget with
-- the given 'TextBuffer'.
--
textViewNewWithBuffer :: TextBuffer -> IO TextView
textViewNewWithBuffer tb = makeNewGObject mkTextView $ liftM castPtr $
  {#call unsafe text_view_new_with_buffer#} tb

-- | Set the 'TextBuffer' for a given 'TextView' widget.
--
textViewSetBuffer :: TextViewClass tv => tv -> TextBuffer -> IO ()
textViewSetBuffer tv tb = 
  {#call text_view_set_buffer#} (toTextView tv) tb

-- | Returns the 'TextBuffer' being displayed by this text view.
--
textViewGetBuffer :: TextViewClass tv => tv -> IO TextBuffer
textViewGetBuffer tv = makeNewGObject mkTextBuffer $
  {#call unsafe text_view_get_buffer#} (toTextView tv)

-- | Scroll to the position of the supplied
-- 'TextMark'.
--
-- * Supplying @xalign@, @yalign@ gives a goal position of
--   the 'TextMark' within screen bounds. 0,0 means left, top and
--   1.0,1.0 means right, bottom.
--
-- * Supply @Nothing@ if the goal is to bring the position into 
--   view with the minimum of scrolling.
--
-- * @withinMargin@ is within \[0.0 .. 0.5) and imposes an extra margin
--   at all four sides of the window within which @xalign@ and
--   @yalign@ are evaluated.
--
-- * The line distances are calculated in an idle handler. Calling this
--   function ensures that the line heights are indeed evaluated before the
--   scroll is carried out.
--
textViewScrollToMark :: TextViewClass tv => tv -> TextMark -> Double ->
                        Maybe (Double, Double) -> IO ()
textViewScrollToMark tv tm withinMargin (Just (xalign, yalign)) = 
  {#call unsafe text_view_scroll_to_mark#} (toTextView tv) tm 
  (realToFrac withinMargin) 1 (realToFrac xalign) (realToFrac yalign)
textViewScrollToMark tv tm withinMargin Nothing = 
  {#call unsafe text_view_scroll_to_mark#} (toTextView tv) tm 
  (realToFrac withinMargin) 0 (0.0) (0.0)

-- | Scroll to the position of the supplied
-- 'TextIter'.
--
-- * The position might not be correct due to the delayed calculation of the
--   line heights.
--
-- * Returns True if the function actually scrolled.
--
textViewScrollToIter :: TextViewClass tv => tv -> TextIter -> Double ->
                        Maybe (Double, Double) -> IO Bool
textViewScrollToIter tv ti withinMargin (Just (xalign, yalign)) = 
  liftM toBool $ {#call unsafe text_view_scroll_to_iter#} (toTextView tv) 
    ti (realToFrac withinMargin) 1 (realToFrac xalign) 
    (realToFrac yalign)
textViewScrollToIter tv ti withinMargin Nothing = liftM toBool $
  {#call unsafe text_view_scroll_to_iter#} (toTextView tv) ti 
    (realToFrac withinMargin) 0 (0.0) (0.0)

-- | Scroll the visible area of the widget
-- so the 'TextMark' becomes visible.
--
-- * This call is equivalent to 'textViewScrollToMark' tm 0.0
--   Nothing tv.
--
textViewScrollMarkOnscreen :: TextViewClass tv => tv -> TextMark -> IO ()
textViewScrollMarkOnscreen tv tm = 
  {#call unsafe text_view_scroll_mark_onscreen#} (toTextView tv) tm

-- | Move a 'TextMark' within the
-- buffer until it is in the currently visible area of the widget.
--
-- * Returns True if the Mark was moved.
--
textViewMoveMarkOnscreen :: TextViewClass tv => tv -> TextMark -> IO Bool
textViewMoveMarkOnscreen tv tm = liftM toBool $ 
  {#call unsafe text_view_move_mark_onscreen#} (toTextView tv) tm

-- | Move the cursor within the buffer
-- until it is in the currently visible area of the widget.
--
-- * Returns True if the Mark was moved.
--
textViewPlaceCursorOnscreen :: TextViewClass tv => tv -> IO Bool
textViewPlaceCursorOnscreen tv = liftM toBool $ 
  {#call unsafe text_view_place_cursor_onscreen#} (toTextView tv)

-- | Get the currently visible rectangle.
--
-- * Use 'textViewBufferToWindowCoords' to convert into window 
-- coordinates.
--
textViewGetVisibleRect :: TextViewClass tv => tv -> IO Rectangle
textViewGetVisibleRect tv = alloca $ \rectPtr -> do
  {#call unsafe text_view_get_visible_rect#} (toTextView tv) (castPtr rectPtr)
  peek rectPtr


-- | Get a rectangle that roughly contains the 
-- character at 'TextIter'.
--
-- * Use 'textViewBufferToWindowCoords' to convert into window 
--   cooridnates.
--
textViewGetIterLocation :: TextViewClass tv => tv -> TextIter -> IO Rectangle
textViewGetIterLocation tv tm = alloca $ \rectPtr -> do
  {#call unsafe text_view_get_iter_location#} (toTextView tv) tm 
    (castPtr rectPtr)
  peek rectPtr



-- | Get the 'TextIter' at the start of the
-- line containing the coordinate @y@.
--
-- * @y@ is in buffer coordinates.
--
-- * Returns the 'TextIter' and the top of the line.
--
textViewGetLineAtY :: TextViewClass tv => tv -> Int -> IO (TextIter,Int)
textViewGetLineAtY tv y = do
  iter <- makeEmptyTextIter
  lineTop <- liftM fromIntegral $ alloca $ \ltPtr -> do
    {#call unsafe text_view_get_line_at_y#} (toTextView tv) iter 
      (fromIntegral y) ltPtr
    peek ltPtr
  return (iter, lineTop)

-- | Get the y coordinate of the top and the
-- height of the line 'TextIter' is on.
--
textViewGetLineYrange :: TextViewClass tv => tv -> TextIter -> IO (Int,Int)
textViewGetLineYrange tv ti = alloca $ \yPtr -> alloca $ \heightPtr -> do
  {#call unsafe text_view_get_line_yrange#} (toTextView tv) ti yPtr heightPtr
  y <- peek yPtr
  height <- peek heightPtr
  return (fromIntegral y, fromIntegral height)

-- | Retrieves the 'TextIter' at
-- buffer coordinates @x@ and @y@.
--
textViewGetIterAtLocation :: TextViewClass tv => tv -> Int -> Int ->
                             IO TextIter
textViewGetIterAtLocation tv x y = do
  iter <- makeEmptyTextIter
  {#call unsafe text_view_get_iter_at_location#} (toTextView tv) iter 
    (fromIntegral x) (fromIntegral y)
  return iter

-- | Convert buffer cooridnates into
-- window coordinates.
--
textViewBufferToWindowCoords :: TextViewClass tv => tv -> TextWindowType ->
                                (Int,Int) -> IO (Int,Int)
textViewBufferToWindowCoords tv wt (x,y) = 
  alloca $ \xPtr -> alloca $ \yPtr -> do
    {#call unsafe text_view_buffer_to_window_coords#} (toTextView tv) 
      ((fromIntegral.fromEnum) wt) (fromIntegral x) (fromIntegral y) 
      xPtr yPtr
    x' <- peek xPtr
    y' <- peek yPtr
    return (fromIntegral x', fromIntegral y')

-- | Convert window cooridnates into
-- buffer coordinates.
--
textViewWindowToBufferCoords :: TextViewClass tv => tv -> TextWindowType ->
                                (Int,Int) -> IO (Int,Int)
textViewWindowToBufferCoords tv wt (x,y) = 
  alloca $ \xPtr -> alloca $ \yPtr -> do
    {#call unsafe text_view_window_to_buffer_coords#} (toTextView tv) 
      ((fromIntegral.fromEnum) wt) (fromIntegral x) (fromIntegral y) xPtr yPtr
    x' <- peek xPtr
    y' <- peek yPtr
    return (fromIntegral x', fromIntegral y')


-- | Get the underlying 'DrawWindow'.
--
-- * The 'TextWindowType' determines which window of the
--   'TextWidget' we would like to receive.
--
-- * Returns Nothing if there is no 'DrawWindow' of the specified type.
--
textViewGetWindow :: TextViewClass tv => tv -> TextWindowType ->
                     IO (Maybe DrawWindow)
textViewGetWindow tv wt = do
  winPtr <- {#call unsafe text_view_get_window#} (toTextView tv) 
    ((fromIntegral.fromEnum) wt)
  if winPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkDrawWindow (return winPtr)

-- | Retrieve the type of window the
-- 'TextView' widget contains.
--
-- * Usually used to find out which window an event corresponds to. An
--   emission of an event signal of 'TextView' yields a
--   'DrawWindow'. This function can be used to see if the event
--   actually belongs to the main text window.
--
textViewGetWindowType :: TextViewClass tv => tv -> DrawWindow ->
                         IO TextWindowType
textViewGetWindowType tv win = liftM (toEnum.fromIntegral) $
  {#call unsafe text_view_get_window_type#} (toTextView tv) win


-- | Set the border width of the
-- 'TextView' widget.
--
-- * Sets the width of 'TextWindowLeft' or
--   'TextWindowRight', or the height of 'TextWindowTop' or
--   'TextWindowBottom'. Automatically destroys the corresponding
--   window if the size is set to 0 and creates the window if the size is set
--   to non-zero. This function can only used with the four window types
--   mentioned.
--
textViewSetBorderWindowSize :: TextViewClass tv => tv -> TextWindowType ->
                               Int -> IO ()
textViewSetBorderWindowSize tv wt size = 
  {#call unsafe text_view_set_border_window_size#} (toTextView tv) 
  ((fromIntegral.fromEnum) wt) (fromIntegral size)

-- | Retrieve the border width of the
-- specified window.
--
-- * See 'textViewSetBorderWindowSize'.
--
textViewGetBorderWindowSize :: TextViewClass tv => tv -> TextWindowType ->
                               IO Int
textViewGetBorderWindowSize tv wt = liftM fromIntegral $
  {#call unsafe text_view_get_border_window_size#} (toTextView tv) 
  ((fromIntegral.fromEnum) wt)

-- | Move the iterator forwards by one display line.
--
-- * Moves the given 'TextIter' forward by one display (wrapped)
--   line. A display line is different from a paragraph. Paragraphs are
--   separated by newlines or other paragraph separator characters. Display
--   lines are created by line-wrapping a paragraph. If wrapping is turned
--   off, display lines and paragraphs will be the same. Display lines are
--   divided differently for each view, since they depend on the view's width;
--   paragraphs are the same in all views, since they depend on the contents
--   of the 'TextBuffer'.
--
textViewForwardDisplayLine :: TextViewClass tv => tv -> TextIter -> IO Bool
textViewForwardDisplayLine tv ti = liftM toBool $
  {#call unsafe text_view_forward_display_line#} (toTextView tv) ti

-- | Move the iterator backwards by one
-- display line.
--
-- * See 'textViewForwardDisplayLine'.
--
textViewBackwardDisplayLine :: TextViewClass tv => tv -> TextIter -> IO Bool
textViewBackwardDisplayLine tv ti = liftM toBool $
  {#call unsafe text_view_backward_display_line#} (toTextView tv) ti
 
-- | Move the iterator forwards and to the end.
--
-- * Like 'textViewForwardDisplayLine' but moves to the end of 
--   the line as well.
--
textViewForwardDisplayLineEnd :: TextViewClass tv => TextIter -> tv -> IO Bool
textViewForwardDisplayLineEnd ti tv = liftM toBool $
  {#call unsafe text_view_forward_display_line_end#} (toTextView tv) ti

-- | Move the iterator backwards and to the end.
--
-- * See 'textViewForwardDisplayLineEnd'.
--
textViewBackwardDisplayLineEnd :: TextViewClass tv => tv -> TextIter -> IO Bool
textViewBackwardDisplayLineEnd tv ti = liftM toBool $
  {#call unsafe text_view_backward_display_line_start#} (toTextView tv) ti

-- | Move the iterator forwards and to the start.
--
-- * Like 'textViewForwardDisplayLine' but moves to the start of
--   the line as well.
--
textViewForwardDisplayLineStart :: TextViewClass tv => tv -> TextIter ->
                                   IO Bool
textViewForwardDisplayLineStart tv ti = liftM toBool $
  {#call unsafe text_view_forward_display_line_end#} (toTextView tv) ti

-- | Move the iterator backwards and to the start.
--
-- * See 'textViewForwardDisplayLineStart'.
--
textViewBackwardDisplayLineStart :: TextViewClass tv => tv -> TextIter ->
                                    IO Bool
textViewBackwardDisplayLineStart tv ti = liftM toBool $
  {#call unsafe text_view_backward_display_line_start#} (toTextView tv) ti

-- | Determines whether the iter is at the start of a display line.
--
-- * See 'textViewForwardDisplayLine' for an explanation of display lines vs.
-- paragraphs.
--
textViewStartsDisplayLine :: TextViewClass tv => tv -> TextIter -> IO Bool
textViewStartsDisplayLine tv ti = liftM toBool $
  {#call unsafe text_view_starts_display_line#} (toTextView tv) ti 

-- | Move the iterator a number of lines.
--
-- * The @count@ is in display lines. See 'textViewForwardDisplayLine'.
--
textViewMoveVisually :: TextViewClass tv => tv -> TextIter -> Int -> IO Bool
textViewMoveVisually tv ti count = liftM toBool $
  {#call unsafe text_view_move_visually#} (toTextView tv) ti 
    (fromIntegral count)


-- | Add a child widget in the
-- 'TextBuffer' at a given 'TextChildAnchor'.
--
textViewAddChildAtAnchor :: (TextViewClass tv , WidgetClass w) => tv -> w ->
                            TextChildAnchor -> IO ()
textViewAddChildAtAnchor tv w anchor = 
  {#call unsafe text_view_add_child_at_anchor#} (toTextView tv) (toWidget w) 
    anchor

-- | Create a new 'TextChildAnchor'.
--
-- * Using 'textBufferCreateChildAnchor' is usually simpler then
--   executing this function and 'textBufferInsertChildAnchor'.
--
textChildAnchorNew :: IO TextChildAnchor
textChildAnchorNew  = makeNewGObject mkTextChildAnchor 
  {#call unsafe text_child_anchor_new#}


-- | Retrieve all 'Widget's at this
-- 'TextChildAnchor'.
--
-- * The widgets in the returned list need to be upcasted to what they were.
--
textChildAnchorGetWidgets :: TextChildAnchor -> IO [Widget]
textChildAnchorGetWidgets tca = do
  gList <- {#call text_child_anchor_get_widgets#} tca
  wList <- fromGList gList
  mapM (makeNewObject mkWidget) (map return wList)

-- | Query if an anchor was deleted.
--
textChildAnchorGetDeleted :: TextChildAnchor -> IO Bool
textChildAnchorGetDeleted tca = liftM toBool $
  {#call unsafe text_child_anchor_get_deleted#} tca

-- | Place a widget in within the text.
--
-- * This function places a 'Widget' at an absolute pixel position
--   into the 'TextView'. Note that any scrolling will leave the
--   widget in the same spot as it was.
--
-- * The position @x@, @y@ is relative to the 
--   'DrawWindow' specified by 'TextWindowType'.
--
textViewAddChildInWindow :: (TextViewClass tv , WidgetClass w) => tv -> w ->
			    TextWindowType -> Int -> Int -> IO ()
textViewAddChildInWindow tv w twt x y = {#call text_view_add_child_in_window#}
  (toTextView tv) (toWidget w) ((fromIntegral.fromEnum) twt)
  (fromIntegral x) (fromIntegral y)

-- | Move a child widget within the
-- 'TextView'.
--
textViewMoveChild :: (TextViewClass tv , WidgetClass w) => tv -> w ->
							   Int -> Int -> IO ()
textViewMoveChild tv w x y = {#call text_view_move_child#}
  (toTextView tv) (toWidget w) (fromIntegral x) (fromIntegral y)

-- | Specify how to wrap text.
--
textViewSetWrapMode :: TextViewClass tv => tv -> WrapMode -> IO ()
textViewSetWrapMode tv wm = {#call text_view_set_wrap_mode#} (toTextView tv)
  ((fromIntegral.fromEnum) wm)

-- | Query how text is wrapped.
--
textViewGetWrapMode :: TextViewClass tv => tv -> IO WrapMode
textViewGetWrapMode tv = liftM (toEnum.fromIntegral) $
  {#call unsafe text_view_get_wrap_mode#} (toTextView tv)

-- | Toggle whether the text in the
-- 'TextView' is editable or not.
--
textViewSetEditable :: TextViewClass tv => tv -> Bool -> IO ()
textViewSetEditable tv editable =
  {#call text_view_set_editable#} (toTextView tv) (fromBool editable)

-- | Retrieve information whether a
-- 'TextView' is editable or not.
--
textViewGetEditable :: TextViewClass tv => tv -> IO Bool
textViewGetEditable tv = liftM toBool $
  {#call unsafe text_view_get_editable#} (toTextView tv)

-- | Toggle whether the cursor in the
-- 'TextView' is visible or not.
--
textViewSetCursorVisible :: TextViewClass tv => tv -> Bool -> IO ()
textViewSetCursorVisible tv editable =
  {#call text_view_set_cursor_visible#} (toTextView tv) (fromBool editable)

-- | Retrieve information whether the cursor
-- in a 'TextView' is visible or not.
--
textViewGetCursorVisible :: TextViewClass tv => tv -> IO Bool
textViewGetCursorVisible tv = liftM toBool $
  {#call unsafe text_view_get_cursor_visible#} (toTextView tv)

-- | Set the number of pixels above each
-- paragraph.
--
-- * Tags in the buffer may override this default.
--
textViewSetPixelsAboveLines :: TextViewClass tv => tv -> Int -> IO ()
textViewSetPixelsAboveLines tv p = {#call text_view_set_pixels_above_lines#}
  (toTextView tv) (fromIntegral p)

-- | Get the number of pixels above each
-- paragraph.
--
-- * Tags in the buffer may override this default.
--
textViewGetPixelsAboveLines :: TextViewClass tv => tv -> IO Int
textViewGetPixelsAboveLines tv = liftM (fromIntegral) $
  {#call unsafe text_view_get_pixels_above_lines#} (toTextView tv)

-- | Set the number of pixels below each
-- paragraph.
--
-- * Tags in the buffer may override this default.
--
textViewSetPixelsBelowLines :: TextViewClass tv => tv -> Int -> IO ()
textViewSetPixelsBelowLines tv p = {#call text_view_set_pixels_below_lines#}
  (toTextView tv) (fromIntegral p)

-- | Get the number of pixels below each
-- paragraph.
--
-- * Tags in the buffer may override this default.
--
textViewGetPixelsBelowLines :: TextViewClass tv => tv -> IO Int
textViewGetPixelsBelowLines tv = liftM (fromIntegral) $
  {#call unsafe text_view_get_pixels_below_lines#} (toTextView tv)

-- | Set the number of pixels between
-- lines inside a wraped paragraph.
--
-- * Tags in the buffer may override this default.
--
textViewSetPixelsInsideWrap :: TextViewClass tv => tv -> Int -> IO ()
textViewSetPixelsInsideWrap tv p = 
  {#call text_view_set_pixels_inside_wrap#} (toTextView tv) (fromIntegral p)

-- | Get the number of pixels between
-- lines inside a wraped paragraph.
--
-- * Tags in the buffer may override this default.
--
textViewGetPixelsInsideWrap :: TextViewClass tv => tv -> IO Int
textViewGetPixelsInsideWrap tv = liftM (fromIntegral) $
  {#call unsafe text_view_get_pixels_inside_wrap#} (toTextView tv)

-- | Specify how to wrap text.
--
textViewSetJustification :: TextViewClass tv => tv -> Justification -> IO ()
textViewSetJustification tv j = {#call text_view_set_justification#}
  (toTextView tv) ((fromIntegral.fromEnum) j)

-- | Query how text is wrapped.
--
textViewGetJustification :: TextViewClass tv => tv -> IO Justification
textViewGetJustification tv = liftM (toEnum.fromIntegral) $
  {#call unsafe text_view_get_justification#} (toTextView tv)

-- | Set the number of pixels in the margin.
--
-- * Tags in the buffer may override this default.
--
textViewSetLeftMargin :: TextViewClass tv => tv -> Int -> IO ()
textViewSetLeftMargin tv p = {#call text_view_set_left_margin#}
  (toTextView tv) (fromIntegral p)

-- | Get the number of pixels in the margin.
--
-- * Tags in the buffer may override this default.
--
textViewGetLeftMargin :: TextViewClass tv => tv -> IO Int
textViewGetLeftMargin tv = liftM (fromIntegral) $
  {#call unsafe text_view_get_left_margin#} (toTextView tv)

-- | Set the number of pixels in the margin.
--
-- * Tags in the buffer may override this default.
--
textViewSetRightMargin :: TextViewClass tv => tv -> Int -> IO ()
textViewSetRightMargin tv p = {#call text_view_set_right_margin#}
  (toTextView tv) (fromIntegral p)

-- | Get the number of pixels in the margin.
--
-- * Tags in the buffer may override this default.
--
textViewGetRightMargin :: TextViewClass tv => tv -> IO Int
textViewGetRightMargin tv = liftM (fromIntegral) $
  {#call unsafe text_view_get_right_margin#} (toTextView tv)

-- | Set the indentation in pixels for the first line
-- in a paragraph.
--
-- * Tags in the buffer may override this default.
--
-- * The indentation may be negative.
--
textViewSetIndent :: TextViewClass tv => tv -> Int -> IO ()
textViewSetIndent tv p = {#call text_view_set_indent#}
  (toTextView tv) (fromIntegral p)

-- | Get the indentation in pixels for the first line
-- in a paragraph.
--
-- * Tags in the buffer may override this default.
--
-- * The indentation may be negative.
--
textViewGetIndent :: TextViewClass tv => tv -> IO Int
textViewGetIndent tv = liftM (fromIntegral) $
  {#call unsafe text_view_get_indent#} (toTextView tv)

-- | Obtains a copy of the default text attributes. These are the attributes
-- used for text unless a tag overrides them.
--
textViewGetDefaultAttributes :: TextViewClass tv => tv -> IO TextAttributes
textViewGetDefaultAttributes tv =
  {#call gtk_text_view_get_default_attributes#} (toTextView tv)
   >>= makeNewTextAttributes


-- Signals

-- | Copying to the clipboard.
--
-- * This signal is emitted when a selection is copied to the clipboard. 
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onCopyClipboard, afterCopyClipboard :: TextViewClass tv => tv -> IO () ->
							   IO (ConnectId tv)
onCopyClipboard = connect_NONE__NONE "copy_clipboard" False
afterCopyClipboard = connect_NONE__NONE "copy_clipboard" True

-- | Cutting to the clipboard.
--
-- * This signal is emitted when a selection is cut out and copied to the
--   clipboard. The action itself happens when the textview processed this
--   request.
--
onCutClipboard, afterCutClipboard :: TextViewClass tv => tv -> IO () ->
							 IO (ConnectId tv)
onCutClipboard = connect_NONE__NONE "cut_clipboard" False
afterCutClipboard = connect_NONE__NONE "cut_clipboard" True

-- | Deleting text.
--
-- * The widget will remove the specified number of units in the text where
--   the meaning of units depends on the kind of deletion.
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onDeleteFromCursor, afterDeleteFromCursor :: TextViewClass tv => tv ->
					     (DeleteType -> Int -> IO ()) ->
					     IO (ConnectId tv)
onDeleteFromCursor = connect_ENUM_INT__NONE "delete_from_cursor" False
afterDeleteFromCursor = connect_ENUM_INT__NONE "delete_from_cursor" True

-- | Inserting text.
--
-- * The widget will insert the string into the text where the meaning
--   of units depends on the kind of deletion.
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onInsertAtCursor, afterInsertAtCursor :: TextViewClass tv => tv ->
							(String -> IO ()) ->
							IO (ConnectId tv)
onInsertAtCursor = connect_STRING__NONE "insert_at_cursor" False
afterInsertAtCursor = connect_STRING__NONE "insert_at_cursor" True

-- | Moving the cursor.
--
-- * The signal specifies what kind and how many steps the cursor will do.
--   The flag is set to @True@ if this movement extends a selection.
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onMoveCursor, afterMoveCursor :: TextViewClass tv => tv ->
				 (MovementStep -> Int -> Bool -> IO ()) ->
				 IO (ConnectId tv)
onMoveCursor = connect_ENUM_INT_BOOL__NONE "move_cursor" False
afterMoveCursor = connect_ENUM_INT_BOOL__NONE "move_cursor" True

-- | Moving the focus.
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onMoveFocus, afterMoveFocus :: TextViewClass tv => tv ->
			       (DirectionType -> IO ()) ->
			       IO (ConnectId tv)
onMoveFocus = connect_ENUM__NONE "move_focus" False
afterMoveFocus = connect_ENUM__NONE "move_focus" True

-- | Page change signals.
--
-- * The signal specifies how many pages the view should move up or down.
--   The flag is set to @True@ if this movement extends a selection.
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
-- * Figure out why this signal is called horizontally, not vertically.
--
onPageHorizontally, afterPageHorizontally :: TextViewClass tv => tv ->
					     (Int -> Bool -> IO ()) ->
					     IO (ConnectId tv)
onPageHorizontally = connect_INT_BOOL__NONE "page_horizontally" False
afterPageHorizontally = connect_INT_BOOL__NONE "page_horizontally" True


-- | Pasting from the clipboard.
--
-- * This signal is emitted when something is pasted from the clipboard. 
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onPasteClipboard, afterPasteClipboard :: TextViewClass tv => tv -> IO () ->
							IO (ConnectId tv)
onPasteClipboard = connect_NONE__NONE "paste_clipboard" False
afterPasteClipboard = connect_NONE__NONE "paste_clipboard" True

-- | Add menu entries to context menus.
--
-- * This signal is emitted if a context menu within the 'TextView'
--   is opened. This signal can be used to add application specific menu
--   items to this popup.
--
onPopulatePopup, afterPopulatePopup :: TextViewClass tv => tv ->
						      (Menu -> IO ()) ->
						      IO (ConnectId tv)
onPopulatePopup = connect_OBJECT__NONE "populate_popup" False
afterPopulatePopup = connect_OBJECT__NONE "populate_popup" True

-- | Inserting an anchor.
--
-- * This signal is emitted when anchor is inserted into the text. 
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onSetAnchor, afterSetAnchor :: TextViewClass tv => tv -> IO () ->
					      IO (ConnectId tv)
onSetAnchor = connect_NONE__NONE "set_anchor" False
afterSetAnchor = connect_NONE__NONE "set_anchor" True

-- | The scroll-bars changed.
--
--
onSetScrollAdjustments, afterSetScrollAdjustments ::
  TextViewClass tv => tv -> (Adjustment -> Adjustment -> IO ()) -> 
  IO (ConnectId tv)
onSetScrollAdjustments = 
  connect_OBJECT_OBJECT__NONE "set_scroll_adjustments" False
afterSetScrollAdjustments = 
  connect_OBJECT_OBJECT__NONE "set_scroll_adjustments" True

-- | Insert\/Overwrite mode has changed.
--
-- * This signal is emitted when the 'TextView' changes from
--   inserting mode to overwriting mode and vice versa. 
--
-- * The action itself happens when the 'TextView' processes this
--   signal.
--
onToggleOverwrite, afterToggleOverwrite :: TextViewClass tv => tv -> IO () ->
							  IO (ConnectId tv)
onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False
afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Multiline TextIter.chs.pp,NONE,1.1 TextTag.chs.pp,NONE,1.1

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

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

Added Files:
	TextIter.chs.pp TextTag.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: TextIter.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) TextIter TextBuffer
--
--  Author : Axel Simon
--          
--  Created: 23 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:28:53 $
--
--  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.
--
-- |
--
-- An iterator is an abstract datatype representing a pointer into a 
-- 'TextBuffer'.
--
-- * The following functions do not make sense due to Haskell's wide character
--   representation of Unicode:
--     gtk_text_iter_get_line_index
--     gtk_text_iter_get_visible_line_index
--     gtk_text_iter_get_bytes_in_line
--     gtk_text_iter_set_line_index
--     gtk_text_iter_set_visible_line_index
--
-- * The functions gtk_text_iter_in_range and gtk_text_iter_order are not bound
--   because they are only convenience functions which can replaced by calls
--   to textIterCompare.
--
-- * All offsets are counted from 0.
--
-- TODO
--
-- * Bind the following function when GSList is bound:
--     gtk_text_iter_get_marks
--     gtk_text_iter_get_toggled_tags
--     gtk_text_iter_get_tags
--
-- * Bind the following functions when we are sure about anchors 
--   (see 'TextBuffer'):
--     gtk_text_iter_get_anchor
--
-- * Bind TextAttribute functions when I am clear how to model them. 
--     gtk_text_iter_get_attribute
--
-- * Forward exceptions in the two callback functions.
--
module Graphics.UI.Gtk.Multiline.TextIter (
  TextIter(TextIter),
  mkTextIter,
  makeEmptyTextIter,	-- for internal use only
  textIterGetBuffer,
  textIterCopy,
  textIterGetOffset,
  textIterGetLine,
  textIterGetLineOffset,
  textIterGetVisibleLineOffset,
  textIterGetChar,
  textIterGetSlice,
  textIterGetText,
  textIterGetVisibleSlice,
  textIterGetVisibleText,
  textIterGetPixbuf,
  textIterBeginsTag,
  textIterEndsTag,
  textIterTogglesTag,
  textIterHasTag,
  textIterEditable,
  textIterCanInsert,
  textIterStartsWord,
  textIterEndsWord,
  textIterInsideWord,
  textIterStartsLine,
  textIterEndsLine,
  textIterStartsSentence,
  textIterEndsSentence,
  textIterInsideSentence,
  textIterIsCursorPosition,
  textIterGetCharsInLine,
  textIterIsEnd,
  textIterIsStart,
  textIterForwardChar,
  textIterBackwardChar,
  textIterForwardChars,
  textIterBackwardChars,
  textIterForwardLine,
  textIterBackwardLine,
  textIterForwardLines,
  textIterBackwardLines,
  textIterForwardWordEnds,
  textIterBackwardWordStarts,
  textIterForwardWordEnd,
  textIterBackwardWordStart,
  textIterForwardCursorPosition,
  textIterBackwardCursorPosition,
  textIterForwardCursorPositions,
  textIterBackwardCursorPositions,
  textIterForwardSentenceEnds,
  textIterBackwardSentenceStarts,
  textIterForwardSentenceEnd,
  textIterBackwardSentenceStart,
  textIterSetOffset,
  textIterSetLine,
  textIterSetLineOffset,
  textIterSetVisibleLineOffset,
  textIterForwardToEnd,
  textIterForwardToLineEnd,
  textIterForwardToTagToggle,
  textIterBackwardToTagToggle,
  textIterForwardFindChar,
  textIterBackwardFindChar,
  textIterForwardSearch,
  textIterBackwardSearch,
  textIterEqual,
  textIterCompare
  ) where

import Monad	(liftM)
import Maybe	(fromMaybe)
import Char	(chr)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject		(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(textIterSize)
import Graphics.UI.Gtk.General.Enums	(TextSearchFlags, Flags(fromFlags))

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

-- methods

{#pointer *TextIter foreign newtype #}

-- Create a TextIter from a pointer.
--
mkTextIter :: Ptr TextIter -> IO TextIter
mkTextIter iterPtr = liftM TextIter $ 
  newForeignPtr iterPtr (text_iter_free iterPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&gtk_text_iter_free"
  text_iter_free' :: FinalizerPtr TextIter

text_iter_free :: Ptr TextIter -> FinalizerPtr TextIter
text_iter_free _ = text_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "gtk_text_iter_free"
  text_iter_free :: Ptr TextIter -> IO ()

#else

foreign import ccall "gtk_text_iter_free" unsafe
  text_iter_free :: Ptr TextIter -> IO ()

#endif

-- Allocate memory to be filled with a TextIter.
--
makeEmptyTextIter :: IO TextIter
makeEmptyTextIter = do
  iterPtr <- mallocBytes textIterSize
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- | Return the 'TextBuffer' this iterator
-- is associated with.
--
textIterGetBuffer :: TextIter -> IO TextBuffer
textIterGetBuffer ti = makeNewGObject mkTextBuffer $
  {#call unsafe text_iter_get_buffer#} ti

-- | Copy the iterator.
--
textIterCopy :: TextIter -> IO TextIter
textIterCopy ti = do
  iterPtr <- {#call unsafe text_iter_copy#} ti
  liftM TextIter $ newForeignPtr iterPtr (text_iter_free iterPtr)

-- | Extract the offset relative to the beginning of
-- the buffer.
--
textIterGetOffset :: TextIter -> IO Int
textIterGetOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_offset#} ti

-- | Extract the line of the buffer.
--
textIterGetLine :: TextIter -> IO Int
textIterGetLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line#} ti

-- | Extract the offset relative to the beginning
-- of the line.
--
textIterGetLineOffset :: TextIter -> IO Int
textIterGetLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_line_offset#} ti

-- | Extract the offset relative to the
-- beginning of the line skipping invisible parts of the line.
--
textIterGetVisibleLineOffset :: TextIter -> IO Int
textIterGetVisibleLineOffset ti = liftM fromIntegral $
  {#call unsafe text_iter_get_visible_line_offset#} ti

-- | Return the character at this iterator.
--
textIterGetChar :: TextIter -> IO (Maybe Char)
textIterGetChar ti = do
  res <- liftM fromIntegral $ {#call unsafe text_iter_get_char#} ti
  return $ if res==0 then Nothing else Just (chr res)

-- | Return the text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetSlice :: TextIter -> TextIter -> IO String
textIterGetSlice end start = do
  cStr <- {#call text_iter_get_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetText :: TextIter -> TextIter -> IO String
textIterGetText start end = do
  cStr <- {#call text_iter_get_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the visible text in a given range.
--
-- * Pictures (and other objects) are represented by 0xFFFC.
--
textIterGetVisibleSlice :: TextIter -> TextIter -> IO String
textIterGetVisibleSlice start end = do
  cStr <- {#call text_iter_get_visible_slice#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Return the visible text in a given range.
--
-- * Pictures (and other objects) are stripped form the output.
--
textIterGetVisibleText :: TextIter -> TextIter -> IO String
textIterGetVisibleText start end = do
  cStr <- {#call text_iter_get_visible_text#} start end
  str <- peekUTFString cStr
  {#call unsafe g_free#} (castPtr cStr)
  return str

-- | Get the 'Pixbuf' under the iterator.
--
textIterGetPixbuf :: TextIter -> IO (Maybe Pixbuf)
textIterGetPixbuf it = do
  pbPtr <- {#call unsafe text_iter_get_pixbuf#} it
  if pbPtr==nullPtr then return Nothing else liftM Just $
    makeNewGObject mkPixbuf (return pbPtr)


-- | Query whether a 'TextIter' is at the
-- start of a 'TextTag'.
--
textIterBeginsTag :: TextIter -> TextTag -> IO Bool
textIterBeginsTag ti tt = liftM toBool $
  {#call unsafe text_iter_begins_tag#} ti tt


-- | Query whether a 'TextIter' is at the end
-- of a 'TextTag'.
--
textIterEndsTag :: TextIter -> TextTag -> IO Bool
textIterEndsTag ti tt = liftM toBool $
  {#call unsafe text_iter_ends_tag#} ti tt

-- | Query if the 'TextIter' is at the
-- beginning or the end of a 'TextTag'.
--
textIterTogglesTag :: TextIter -> TextTag -> IO Bool
textIterTogglesTag ti tt = liftM toBool $
  {#call unsafe text_iter_toggles_tag#} ti tt

-- | Check if 'TextIter' is within a range
-- tagged with tag.
--
textIterHasTag :: TextIter -> TextTag -> IO Bool
textIterHasTag ti tt = liftM toBool $
  {#call unsafe text_iter_has_tag#} ti tt

-- | Check if 'TextIter' is within an
-- editable region.
--
-- * If no tags that affect editability are attached to the current position
--   @def@ will be returned.
--
-- * This function cannot be used to decide whether text can be inserted at
--   'TextIter'. Use the 'textIterCanInsert' function for
--   this purpose.
--
textIterEditable :: TextIter -> Bool -> IO Bool
textIterEditable ti def = liftM toBool $ 
  {#call unsafe text_iter_editable#} ti (fromBool def)

-- | Check if new text can be inserted at
-- 'TextIter'.
--
-- * Use 'textBufferInsertInteractive' if you want to insert text
--   depending on the current editable status.
--
textIterCanInsert :: TextIter -> Bool -> IO Bool
textIterCanInsert ti def = liftM toBool $ 
  {#call unsafe text_iter_can_insert#} ti (fromBool def)

-- | Determine if 'TextIter' begins a new
-- natural-language word.
--
textIterStartsWord :: TextIter -> IO Bool
textIterStartsWord ti = liftM toBool $ {#call unsafe text_iter_starts_word#} ti


-- | Determine if 'TextIter' ends a new
-- natural-language word.
--
textIterEndsWord :: TextIter -> IO Bool
textIterEndsWord ti = liftM toBool $ {#call unsafe text_iter_ends_word#} ti

-- | Determine if 'TextIter' is inside a
-- word.
--
textIterInsideWord :: TextIter -> IO Bool
textIterInsideWord ti = liftM toBool $ {#call unsafe text_iter_inside_word#} ti

-- | Determine if 'TextIter' begins a new
-- line.
--
textIterStartsLine :: TextIter -> IO Bool
textIterStartsLine ti = liftM toBool $ {#call unsafe text_iter_starts_line#} ti

-- | Determine if 'TextIter' point to the
-- beginning of a line delimiter.
--
-- * Returns False if 'TextIter' points to the \n in a \r\n sequence.
--
textIterEndsLine :: TextIter -> IO Bool
textIterEndsLine ti = liftM toBool $ {#call unsafe text_iter_ends_line#} ti

-- | Determine if 'TextIter' starts a
-- sentence.
--
textIterStartsSentence :: TextIter -> IO Bool
textIterStartsSentence ti = liftM toBool $ 
  {#call unsafe text_iter_starts_sentence#} ti

-- | Determine if 'TextIter' ends a
-- sentence.
--
textIterEndsSentence :: TextIter -> IO Bool
textIterEndsSentence ti = liftM toBool $ 
  {#call unsafe text_iter_ends_sentence#} ti

-- | Determine if 'TextIter' is inside
-- a sentence.
--
textIterInsideSentence :: TextIter -> IO Bool
textIterInsideSentence ti = liftM toBool $ 
  {#call unsafe text_iter_inside_sentence#} ti

-- | Determine if 'TextIter' is at a
-- cursor position.
--
textIterIsCursorPosition :: TextIter -> IO Bool
textIterIsCursorPosition ti = liftM toBool $ 
  {#call unsafe text_iter_is_cursor_position#} ti

-- | Return number of characters in this line.
--
-- * The return value includes delimiters.
--
textIterGetCharsInLine :: TextIter -> IO Int
textIterGetCharsInLine ti = liftM fromIntegral $
  {#call unsafe text_iter_get_chars_in_line#} ti

-- | Get the text attributes at the iterator.
--
-- * The @ta@ argument gives the default values if no specific 
--   attributes are set at that specific location.
--
-- * The function returns @Nothing@ if the text at the iterator has 
--   the same attributes.
textIterGetAttributes = undefined

-- | Determine if 'TextIter' is at the end of
-- the buffer.
--
textIterIsEnd :: TextIter -> IO Bool
textIterIsEnd ti = liftM toBool $ 
  {#call unsafe text_iter_is_end#} ti

-- | Determine if 'TextIter' is at the
-- beginning of the buffer.
--
textIterIsStart :: TextIter -> IO Bool
textIterIsStart ti = liftM toBool $ 
  {#call unsafe text_iter_is_start#} ti

-- | Move 'TextIter' forwards.
--
-- * Retuns True if the iterator is pointing to a character.
--
textIterForwardChar :: TextIter -> IO Bool
textIterForwardChar ti = liftM toBool $ 
  {#call unsafe text_iter_forward_char#} ti

-- | Move 'TextIter' backwards.
--
-- * Retuns True if the movement was possible.
--
textIterBackwardChar :: TextIter -> IO Bool
textIterBackwardChar ti = liftM toBool $ 
  {#call unsafe text_iter_backward_char#} ti

-- | Move 'TextIter' forwards by
-- @n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterForwardChars :: TextIter -> Int -> IO Bool
textIterForwardChars ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_chars#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ characters.
--
-- * Retuns True if the iterator is pointing to a new character (and False if
--   the iterator points to a picture or has not moved).
--
textIterBackwardChars :: TextIter -> Int -> IO Bool
textIterBackwardChars ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_chars#} ti (fromIntegral n)


-- | Move 'TextIter' forwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the
--   beginning of the buffer.
--
textIterForwardLine :: TextIter -> IO Bool
textIterForwardLine ti = liftM toBool $ 
  {#call unsafe text_iter_forward_line#} ti

-- | Move 'TextIter' backwards.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the end
--   of the buffer.
--
textIterBackwardLine :: TextIter -> IO Bool
textIterBackwardLine ti = liftM toBool $ 
  {#call unsafe text_iter_backward_line#} ti


-- | Move 'TextIter' forwards by
-- @n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the
--   beginning of the buffer.
--
-- * @n@ can be negative.
--
textIterForwardLines :: TextIter -> Int -> IO Bool
textIterForwardLines ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_lines#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ lines.
--
-- * Retuns True if the iterator is pointing to a new line (and False if the
--   iterator points to a picture or has not moved).
--
-- * If 'TextIter' is on the first line, it will be moved to the end
--   of the buffer.
--
-- * @n@ can be negative.
--
textIterBackwardLines :: TextIter -> Int -> IO Bool
textIterBackwardLines ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_lines#} ti (fromIntegral n)

-- | Move 'TextIter' forwards by
-- @n@ word ends.
--
-- * Retuns True if the iterator is pointing to a new word end.
--
textIterForwardWordEnds :: TextIter -> Int -> IO Bool
textIterForwardWordEnds ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_word_ends#} ti (fromIntegral n)

-- | Move 'TextIter' backwards by
-- @n@ word beginnings.
--
-- * Retuns True if the iterator is pointing to a new word start.
--
textIterBackwardWordStarts :: TextIter -> Int -> IO Bool
textIterBackwardWordStarts ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_word_starts#} ti (fromIntegral n)

-- | Move 'TextIter' forwards to the
-- next word end.
--
-- * Retuns True if the iterator has moved to a new word end.
--
textIterForwardWordEnd :: TextIter -> IO Bool
textIterForwardWordEnd ti = liftM toBool $ 
  {#call unsafe text_iter_forward_word_end#} ti

-- | Move 'TextIter' backwards to
-- the next word beginning.
--
-- * Retuns True if the iterator has moved to a new word beginning.
--
textIterBackwardWordStart :: TextIter -> IO Bool
textIterBackwardWordStart ti = liftM toBool $ 
  {#call unsafe text_iter_backward_word_start#} ti

-- | Move 'TextIter' forwards to
-- the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that 'TextIter' does not point inbetween such double characters.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterForwardCursorPosition :: TextIter -> IO Bool
textIterForwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_forward_cursor_position#} ti

-- | Move 'TextIter' backwards
-- to the next cursor position.
--
-- * Some characters are composed of two Unicode codes. This function ensures
--   that 'TextIter' does not point inbetween such double characters.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPosition :: TextIter -> IO Bool
textIterBackwardCursorPosition ti = liftM toBool $
  {#call unsafe text_iter_backward_cursor_position#} ti

-- | Move 'TextIter' forwards
-- by @n@ cursor positions.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterForwardCursorPositions :: TextIter -> Int -> IO Bool
textIterForwardCursorPositions ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_cursor_positions#} ti (fromIntegral n)

-- | Move 'TextIter' backwards
-- by @n@ cursor positions.
--
-- * Returns True if 'TextIter' moved and points to a character (not
--   to an object).
--
textIterBackwardCursorPositions :: TextIter -> Int -> IO Bool
textIterBackwardCursorPositions ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_cursor_positions#} ti (fromIntegral n)


-- | Move 'TextIter' forwards by
-- @n@ sentence ends.
--
-- * Retuns True if the iterator is pointing to a new sentence end.
--
textIterForwardSentenceEnds :: TextIter -> Int -> IO Bool
textIterForwardSentenceEnds ti n = liftM toBool $ 
  {#call unsafe text_iter_forward_sentence_ends#} ti (fromIntegral n)

-- | Move 'TextIter' backwards
-- by @n@ sentence beginnings.
--
-- * Retuns True if the iterator is pointing to a new sentence start.
--
textIterBackwardSentenceStarts :: TextIter -> Int -> IO Bool
textIterBackwardSentenceStarts ti n = liftM toBool $ 
  {#call unsafe text_iter_backward_sentence_starts#} ti (fromIntegral n)

-- | Move 'TextIter' forwards to
-- the next sentence end.
--
-- * Retuns True if the iterator has moved to a new sentence end.
--
textIterForwardSentenceEnd :: TextIter -> IO Bool
textIterForwardSentenceEnd ti = liftM toBool $ 
  {#call unsafe text_iter_forward_sentence_end#} ti

-- | Move 'TextIter' backwards
-- to the next sentence beginning.
--
-- * Retuns True if the iterator has moved to a new sentence beginning.
--
textIterBackwardSentenceStart :: TextIter -> IO Bool
textIterBackwardSentenceStart ti = liftM toBool $ 
  {#call unsafe text_iter_backward_sentence_start#} ti

-- | Set 'TextIter' to an offset within the
-- buffer.
--
textIterSetOffset :: TextIter -> Int -> IO ()
textIterSetOffset ti n = 
  {#call unsafe text_iter_set_offset#} ti (fromIntegral n)

-- | Set 'TextIter' to a line within the
-- buffer.
--
textIterSetLine :: TextIter -> Int -> IO ()
textIterSetLine ti n = 
  {#call unsafe text_iter_set_line#} ti (fromIntegral n)

-- | Set 'TextIter' to an offset within
-- the line.
--
textIterSetLineOffset :: TextIter -> Int -> IO ()
textIterSetLineOffset ti n = 
  {#call unsafe text_iter_set_line_offset#} ti (fromIntegral n)

-- | Set 'TextIter' to an visible
-- character within the line.
--
textIterSetVisibleLineOffset :: TextIter -> Int -> IO ()
textIterSetVisibleLineOffset ti n = 
  {#call unsafe text_iter_set_visible_line_offset#} ti (fromIntegral n)

-- | Moves 'TextIter' to the end of the
-- buffer.
--
textIterForwardToEnd :: TextIter -> IO ()
textIterForwardToEnd ti = {#call unsafe text_iter_forward_to_end#} ti

-- | Moves 'TextIter' to the end of
-- the line.
--
-- * Returns True if 'TextIter' moved to a new location which is not
--   the buffer end iterator.
--
textIterForwardToLineEnd :: TextIter -> IO Bool
textIterForwardToLineEnd ti = liftM toBool $
  {#call unsafe text_iter_forward_to_line_end#} ti

-- | Moves 'TextIter' forward to
-- the next change of a 'TextTag'.
--
-- * If Nothing is supplied, any 'TextTag' will be matched.
--
-- * Returns True if there was a tag toggle after 'TextIter'.
--
textIterForwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterForwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_forward_to_tag_toggle#} ti 
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- | Moves 'TextIter' backward to
-- the next change of a 'TextTag'.
--
-- * If Nothing is supplied, any 'TextTag' will be matched.
--
-- * Returns True if there was a tag toggle before 'TextIter'.
--
textIterBackwardToTagToggle :: TextIter -> Maybe TextTag -> IO Bool
textIterBackwardToTagToggle ti tt = liftM toBool $
  {#call unsafe text_iter_backward_to_tag_toggle#} ti 
    (fromMaybe (mkTextTag nullForeignPtr) tt)

-- Setup a callback for a predicate function.
--
type TextCharPredicateCB = Char -> Bool

{#pointer TextCharPredicate#}

foreign import ccall "wrapper" mkTextCharPredicate ::
  ({#type gunichar#} -> Ptr () -> {#type gboolean#}) -> IO TextCharPredicate

-- | Move 'TextIter' forward until a
-- predicate function returns True.
--
-- * If @pred@ returns True before @limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @limit@ is Nothing, the search stops at the end of the buffer.
--
textIterForwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                           IO Bool
textIterForwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_forward_find_char#} 
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- | Move 'TextIter' backward until a
-- predicate function returns True.
--
-- * If @pred@ returns True before @limit@ is reached, the
--   search is stopped and the return value is True.
--
-- * If @limit@ is Nothing, the search stops at the end of the buffer.
--
textIterBackwardFindChar :: TextIter -> (Char -> Bool) -> Maybe TextIter ->
                            IO Bool
textIterBackwardFindChar ti pred limit = do
  fPtr <- mkTextCharPredicate (\c _ -> fromBool $ pred (chr (fromIntegral c)))
  res <- liftM toBool $ {#call text_iter_backward_find_char#} 
    ti fPtr nullPtr (fromMaybe (TextIter nullForeignPtr) limit)
  freeHaskellFunPtr fPtr
  return res

-- | Search forward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @limit@.
--
-- * 'TextSearchFlags' may be empty.
--
-- * Returns the start and end position of the string found.
--
textIterForwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                         Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterForwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_forward_search#} ti cStr 
    ((fromIntegral.fromFlags) flags) start end 
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- | Search backward for a specific string.
--
-- * If specified, the last character which is tested against that start of
--   the search pattern will be @limit@.
--
-- * 'TextSearchFlags' my be empty.
--
-- * Returns the start and end position of the string found.
--
textIterBackwardSearch :: TextIter -> String -> [TextSearchFlags] ->
                          Maybe TextIter -> IO (Maybe (TextIter, TextIter))
textIterBackwardSearch ti str flags limit = do
  start  <- makeEmptyTextIter
  end <- makeEmptyTextIter
  found <- liftM toBool $ withUTFString str $ \cStr ->
    {#call unsafe text_iter_backward_search#} ti cStr 
    ((fromIntegral.fromFlags) flags) start end 
    (fromMaybe (TextIter nullForeignPtr) limit)
  return $ if found then Just (start,end) else Nothing

-- | Compare two 'TextIter' for equality.
--
-- * 'TextIter' could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This is done
--   the next abstraction layer.
--
textIterEqual :: TextIter -> TextIter -> IO Bool
textIterEqual ti2 ti1 = liftM toBool $ {#call unsafe text_iter_equal#} ti1 ti2

-- | Compare two 'TextIter'.
--
-- * 'TextIter' could be in class Eq and Ord if there is a guarantee
--   that each iterator is copied before it is modified in place. This could
--   be done the next abstraction layer.
--
textIterCompare :: TextIter -> TextIter -> IO Ordering
textIterCompare ti2 ti1 = do
  res <- {#call unsafe text_iter_compare#} ti1 ti2
  return $ case res of
    (-1)   -> LT
    0	   -> EQ
    1	   -> GT



--- NEW FILE: TextTag.chs.pp ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget TextTag
--
--  Author : Duncan Coutts
--  Created: 4 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A tag that can be applied to text in a "TextBuffer".
--
-- TODO
--
-- * accessor functions for TextAttributes

module Graphics.UI.Gtk.Multiline.TextTag (
  TextTag,
  TextTagClass,
  castToTextTag,
  TagName,
  textTagNew,
  textTagSetPriority,
  textTagGetPriority,
  TextAttributes(..),
  textAttributesNew,
  makeNewTextAttributes,  --internal
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GObject	(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

type TagName = String

-- TextTag methods

-- | Creates a 'TextTag'.
--
textTagNew :: TagName -> IO TextTag
textTagNew name =
  withCString name $ \strPtr ->
  makeNewGObject mkTextTag $ {#call unsafe text_tag_new#} strPtr

-- | Get the tag priority.
--
textTagGetPriority :: TextTagClass obj => obj -> IO Int
textTagGetPriority obj = liftM fromIntegral $
  {#call unsafe text_tag_get_priority#} (toTextTag obj)

-- | Sets the priority of a 'TextTag'.
--
-- Valid priorities are start at 0 and go to one less than
-- 'textTagTableGetSize'. Each tag in a table has a unique priority; setting the
-- priority of one tag shifts the priorities of all the other tags in the table
-- to maintain a unique priority for each tag. Higher priority tags \"win\" if
-- two tags both set the same text attribute. When adding a tag to a tag table,
-- it will be assigned the highest priority in the table by default; so normally
-- the precedence of a set of tags is the order in which they were added to the
-- table, or created with 'textBufferCreateTag', which adds the tag to the
-- buffer's table automatically.
--
textTagSetPriority :: TextTagClass obj => obj -> Int -> IO ()
textTagSetPriority obj priority =
  {#call text_tag_set_priority#} (toTextTag obj) (fromIntegral priority)


-- TextAttributes methods

{#pointer * TextAttributes foreign newtype#}

-- | Creates a 'TextAttributes', which describes a set of properties on some
-- text.
--
textAttributesNew :: IO TextAttributes
textAttributesNew =
  {#call unsafe text_attributes_new#} >>= makeNewTextAttributes

makeNewTextAttributes :: Ptr TextAttributes -> IO TextAttributes
makeNewTextAttributes ptr =
  liftM TextAttributes $ newForeignPtr ptr (text_attributes_unref ptr)

#if __GLASGOW_HASKELL__>=600
                                                                                
foreign import ccall unsafe "&gtk_text_attributes_unref"
  text_attributes_unref' :: FinalizerPtr TextAttributes
                                                                                
text_attributes_unref :: Ptr TextAttributes -> FinalizerPtr TextAttributes
text_attributes_unref _ = text_attributes_unref'
                                                                                
#elif __GLASGOW_HASKELL__>=504
                                                                                
foreign import ccall unsafe "gtk_text_attributes_unref"
  text_attributes_unref :: Ptr TextAttributes -> IO ()
                                                                                
#else
                                                                                
foreign import ccall "gtk_text_attributes_unref" unsafe
  text_attributes_unref :: Ptr TextAttributes -> IO ()
                                                                                
#endif

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Misc Adjustment.chs,NONE,1.1 DrawingArea.chs,NONE,1.1 GArrow.chs,NONE,1.1 HandleBox.chs,NONE,1.1 SizeGroup.chs,NONE,1.1 Viewport.chs,NONE,1.1

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

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

Added Files:
	Adjustment.chs DrawingArea.chs GArrow.chs HandleBox.chs 
	SizeGroup.chs Viewport.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: DrawingArea.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget DrawingArea
--
--  Author : Axel Simon
--          
--  Created: 22 September 2002
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:28:02 $
--
--  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 user-defined widget.
--
-- * The 'DrawingArea' widget is used for creating custom
--   user interface elements. It's essentially a blank widget. Drawing on
--   the 'Drawable' returned by 'drawingAreaGetWindow'
--   has to be done each time the window manager sends @\"expose\"@
--   events. Note that the library automatically clears the exposed area to
--   the background color before sending the expose event, and that drawing
--   is implicitly clipped to the exposed area. Other events which are
--   interesting for interacting are mouse and butten events defined in
--   'Widget'. If the widget changes in size (which it does
--   initially), a @\"configure\"@ event is emitted.
--
module Graphics.UI.Gtk.Misc.DrawingArea (
  DrawingArea,
  DrawingAreaClass,
  castToDrawingArea,
  drawingAreaNew,
  drawingAreaGetDrawWindow,
  drawingAreaGetSize) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(drawingAreaGetDrawWindow, drawingAreaGetSize)

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

-- methods

-- | Create a new custom widget.
--
drawingAreaNew :: IO DrawingArea
drawingAreaNew = makeNewObject mkDrawingArea $ 
  liftM castPtr {#call unsafe drawing_area_new#}


--- NEW FILE: HandleBox.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget HandleBox
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:28:02 $
--
--  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.
--
-- |
--
-- Add a handle to some other widget so that it can be detached and 
-- reattached from the main application.
--
-- * The GtkHandleBox widget allows a portion of a window to be \"torn off\". It
--   is a bin widget which displays its child and a handle that the user can 
--   drag to tear off a separate window (the float window) containing the 
--   child widget. A thin ghost is drawn in the original location of the 
--   handlebox. By dragging the separate window back to its original location,
--   it can be reattached.
--   When reattaching, the ghost and float window, must be aligned along one 
--   of the edges, the snap edge. This either can be specified by the 
--   application programmer explicitely, or GTK+ will pick a reasonable 
--   default based on the handle position.
--   To make detaching and reattaching the handlebox as minimally confusing 
--   as possible to the user, it is important to set the snap edge so that 
--   the snap edge does not move when the handlebox is deattached. For 
--   instance, if the handlebox is packed at the bottom of a 'VBox',
--   then when 
--   the handlebox is detached, the bottom edge of the handlebox's allocation 
--   will remain fixed as the height of the handlebox shrinks, so the snap 
--   edge should be set to 'PosBottom'.
--

module Graphics.UI.Gtk.Misc.HandleBox (
  HandleBox,
  HandleBoxClass,
  castToHandleBox,
  handleBoxNew,
  ShadowType(..),
  handleBoxSetShadowType,
  handleBoxGetShadowType,
  PositionType(..),
  handleBoxSetHandlePosition,
  handleBoxGetHandlePosition,
  handleBoxSetSnapEdge,
  handleBoxGetSnapEdge,
  onChildAttached,
  afterChildAttached,
  onChildDetached,
  afterChildDetached
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new handle box.
--
handleBoxNew :: IO HandleBox
handleBoxNew  = makeNewObject mkHandleBox $ 
  liftM castPtr {#call unsafe handle_box_new#}

-- | Set the shadow type of the detached box.
--
handleBoxSetShadowType :: HandleBoxClass hb => hb -> ShadowType -> IO ()
handleBoxSetShadowType hb shadow = {#call handle_box_set_shadow_type#}
  (toHandleBox hb) ((fromIntegral.fromEnum) shadow)

-- | Get the shadow type of the detached box.
--
handleBoxGetShadowType :: HandleBoxClass hb => hb -> IO ShadowType
handleBoxGetShadowType hb = liftM (toEnum.fromIntegral) $
  {#call unsafe handle_box_get_shadow_type#} (toHandleBox hb)

-- | Set the position of the handle.
--
handleBoxSetHandlePosition :: HandleBoxClass hb => hb -> PositionType -> IO ()
handleBoxSetHandlePosition hb pos = {#call handle_box_set_handle_position#} 
  (toHandleBox hb) ((fromIntegral.fromEnum) pos)

-- | Get the position of the handle.
--
handleBoxGetHandlePosition :: HandleBoxClass hb => hb -> IO PositionType
handleBoxGetHandlePosition hb = liftM (toEnum.fromIntegral) $
  {#call unsafe handle_box_get_handle_position#} (toHandleBox hb)

-- | Set the snap edge of the HandleBox.
--
-- * The snap edge is the edge of the detached child that must be aligned with
--   the corresponding edge of the \"ghost\" left behind when the child was
--   detached to reattach the torn-off window. Usually, the snap edge should
--   be chosen so that it stays in the same place on the screen when the
--   handlebox is torn off. If the snap edge is not set, then an appropriate
--   value will be guessed from the handle position. If the handle position is
--   'PosRight' or 'PosLeft', then the snap edge will
--   be 'PosTop', otherwise it will be 'PosLeft'.
--
handleBoxSetSnapEdge :: HandleBoxClass hb => hb -> PositionType -> IO ()
handleBoxSetSnapEdge hb pos = {#call handle_box_set_snap_edge#}
  (toHandleBox hb) ((fromIntegral.fromEnum) pos)

-- | Gets the edge used for determining reattachment of the handle box. See
-- 'handleBoxSetSnapEdge'.
--
handleBoxGetSnapEdge :: HandleBoxClass hb => hb -> IO PositionType
handleBoxGetSnapEdge hb = liftM (toEnum.fromIntegral) $
  {#call unsafe handle_box_get_snap_edge#} (toHandleBox hb)

-- signals

-- | Emitted when the contents of the handlebox
-- are reattached to the main window.
--
-- * (INTERNAL) We ignore the given Widget.
--
onChildAttached, afterChildAttached :: HandleBoxClass hb => hb -> IO () ->
                                       IO (ConnectId hb)
onChildAttached = connect_NONE__NONE "child-attached" False
afterChildAttached = connect_NONE__NONE "child-attached" True


-- | Emitted when the 'HandleBox' is
-- detached form the main window.
--
onChildDetached, afterChildDetached :: HandleBoxClass hb => hb -> IO () ->
                                       IO (ConnectId hb)
onChildDetached = connect_NONE__NONE "child-detached" False
afterChildDetached = connect_NONE__NONE "child-detached" True



--- NEW FILE: Adjustment.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Adjustment
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:28:02 $
--
--  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.
--
-- | An adjustment is a bounded value controlled by the user.
--
-- An Adjustment object contains a value with maximum bounds and a step size.
-- It is used to represent the value of a scoll bar and similar widgets. In
-- particular it is contained in the abstract 'Range' widget.
--

module Graphics.UI.Gtk.Misc.Adjustment (
  Adjustment,
  AdjustmentClass,
  castToAdjustment,
  adjustmentNew,
  adjustmentSetLower,
  adjustmentGetLower,
  adjustmentSetPageIncrement,
  adjustmentGetPageIncrement,
  adjustmentSetPageSize,
  adjustmentGetPageSize,
  adjustmentSetStepIncrement,
  adjustmentGetStepIncrement,
  adjustmentSetUpper,
  adjustmentGetUpper,
  adjustmentSetValue,
  adjustmentGetValue,
  adjustmentClampPage,
  onAdjChanged,
  afterAdjChanged,
  onValueChanged,
  afterValueChanged
  ) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject, objectSetProperty, objectGetProperty)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import System.Glib.GValue#}

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

-- methods

-- | Create a new Adjustment object.
--
-- * The creation function take every value that is contained in the object:
--   @value@ is the initial value and should be between the
--   @upper@ and @lower@ bounds of the slider. Clicking on the
--   arrows increases this value by @stepIncrement@. Clicking in the
--   slider advances by @pageIncrement@. The @pageSize@ is
--   needed to determine if the end of the slider is still in the range.
--
adjustmentNew :: Double -> Double -> Double -> Double -> Double -> Double ->
                 IO Adjustment
adjustmentNew pageSize value lower upper stepIncrement pageIncrement =
  makeNewObject mkAdjustment $ liftM castPtr $ {#call unsafe adjustment_new#}
  (realToFrac value) (realToFrac lower) (realToFrac upper) 
  (realToFrac stepIncrement) (realToFrac pageIncrement) 
  (realToFrac pageSize)

-- | Set the lower value.
adjustmentSetLower :: Adjustment -> Double -> IO ()
adjustmentSetLower a val = objectSetProperty a "lower" (GVdouble val)

-- | Retrieve the lower value.
adjustmentGetLower :: Adjustment -> IO Double
adjustmentGetLower a = do
  (GVdouble res) <- objectGetProperty a "lower"
  return res

-- | Set the page increment value.
adjustmentSetPageIncrement :: Adjustment -> Double -> IO ()
adjustmentSetPageIncrement a val = objectSetProperty a "page-increment"
				   (GVdouble val)

-- | Retrieve the pageincrement value.
adjustmentGetPageIncrement :: Adjustment -> IO Double
adjustmentGetPageIncrement a = do
  (GVdouble res) <- objectGetProperty a "page-increment"
  return res

-- | Set the page size value.
adjustmentSetPageSize :: Adjustment -> Double -> IO ()
adjustmentSetPageSize a val = objectSetProperty a "page_size" (GVdouble val)

-- | Retrieve the page size value.
adjustmentGetPageSize :: Adjustment -> IO Double
adjustmentGetPageSize a = do
  (GVdouble res) <- objectGetProperty a "page_size"
  return res

-- | Set the step-increment value.
adjustmentSetStepIncrement :: Adjustment -> Double -> IO ()
adjustmentSetStepIncrement a val = objectSetProperty a "step-increment"
				   (GVdouble val)

-- | Retrieve the step-increment value.
adjustmentGetStepIncrement :: Adjustment -> IO Double
adjustmentGetStepIncrement a = do
  (GVdouble res) <- objectGetProperty a "step-increment"
  return res

-- | Set the upper value.
adjustmentSetUpper :: Adjustment -> Double -> IO ()
adjustmentSetUpper a val = objectSetProperty a "upper" (GVdouble val)

-- | Retrieve the upper value.
adjustmentGetUpper :: Adjustment -> IO Double
adjustmentGetUpper a = do
  (GVdouble res) <- objectGetProperty a "upper"
  return res

-- | Set the current value of the Adjustment object.
--
adjustmentSetValue :: Adjustment -> Double -> IO ()
adjustmentSetValue adj value = 
  {#call adjustment_set_value#} adj (realToFrac value)

-- | Get the current value of the Adjustment object.
--
adjustmentGetValue :: Adjustment -> IO Double
adjustmentGetValue adj =
  liftM realToFrac $ {#call adjustment_get_value#} adj

-- | Ensure that the alignment is within these bounds.
--
-- * Updates the Adjustment value to ensure that the range between lower and
--   upper is in the current page (i.e. between value and value + page_size).
--   If the range is larger than the page size, then only the start of it will
--   be in the current page. A \"changed\" signal will be emitted if the value
--   is changed.
--
adjustmentClampPage :: Adjustment -> Double -> Double -> IO ()
adjustmentClampPage a lower upper = {#call adjustment_clamp_page#}
  a (realToFrac lower) (realToFrac upper)

-- signals

-- | This signal is emitted if some value of
-- Adjustment except @value@ itself changes.
--
onAdjChanged, afterAdjChanged :: Adjustment -> IO () ->
                                 IO (ConnectId Adjustment)
onAdjChanged = connect_NONE__NONE "changed" False
afterAdjChanged = connect_NONE__NONE "changed" True

-- | This signal is emitted if the value of the
-- Alignment object changed.
--
onValueChanged, afterValueChanged :: Adjustment -> IO () ->
                                     IO (ConnectId Adjustment)
onValueChanged = connect_NONE__NONE "value-changed" False
afterValueChanged = connect_NONE__NONE "value-changed" True

--- NEW FILE: Viewport.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Viewport
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:28:02 $
--
--  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 'Viewport' a helper widget that adds Adjustment slots to a 
-- widget, i.e. the widget becomes scrollable. It can then be put into 
-- 'ScrolledWindow' and will behave as expected.
--
-- * The binding of this widget is superfluous as far as I can tell.
--
-- * The only signal this widget registers is \"set-scroll-adjustments\". It is
--   not bound because it is meant to be received by the 'Viewport'
--   and sent by 'ScrolledWindow'.
--

module Graphics.UI.Gtk.Misc.Viewport (
  Viewport,
  ViewportClass,
  castToViewport,
  viewportNew,
  viewportGetHAdjustment,
  viewportGetVAdjustment,
  viewportSetHAdjustment,
  viewportSetVAdjustment,
  ShadowType(..),
  viewportSetShadowType,
  viewportGetShadowType
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new 'Viewport'.
--
viewportNew :: Adjustment -> Adjustment -> IO Viewport
viewportNew vAdj hAdj = makeNewObject mkViewport $ liftM castPtr $
  {#call unsafe viewport_new#} hAdj vAdj

-- | Retrieve the horizontal
-- 'Adjustment' of the 'Viewport'.
--
viewportGetHAdjustment :: ViewportClass v => v -> IO Adjustment
viewportGetHAdjustment v = makeNewObject mkAdjustment $
  {#call unsafe viewport_get_hadjustment#} (toViewport v)

-- | Retrieve the vertical 'Adjustment'
-- of the 'Viewport'.
--
viewportGetVAdjustment :: ViewportClass v => v -> IO Adjustment
viewportGetVAdjustment v = makeNewObject mkAdjustment $
  {#call unsafe viewport_get_vadjustment#} (toViewport v)

-- | Set the horizontal 'Adjustment' of
-- the 'Viewport'.
--
viewportSetHAdjustment :: ViewportClass v => v -> Adjustment -> IO ()
viewportSetHAdjustment v adj = {#call viewport_set_hadjustment#}
  (toViewport v) adj

-- | Set the vertical 'Adjustment' of the 'Viewport'.
--
viewportSetVAdjustment :: ViewportClass v => v -> Adjustment -> IO ()
viewportSetVAdjustment v adj = {#call viewport_set_vadjustment#}
  (toViewport v) adj

-- | Specify if and how an outer frame should be drawn around the child.
--
viewportSetShadowType :: ViewportClass v => v -> ShadowType -> IO ()
viewportSetShadowType v st = {#call viewport_set_shadow_type#} (toViewport v)
  ((fromIntegral.fromEnum) st)

-- | Get the current shadow type of the 'Viewport'.
--
viewportGetShadowType :: ViewportClass v => v -> IO ShadowType
viewportGetShadowType v = liftM (toEnum.fromIntegral) $
  {#call unsafe viewport_get_shadow_type#} (toViewport v)

-- signals



--- NEW FILE: GArrow.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget GArrow
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:28:02 $
--
--  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.
--
-- |
--
-- An Arrow pointing to one of the four cardinal direction.
--

module Graphics.UI.Gtk.Misc.GArrow (
  Arrow,
  ArrowClass,
  castToArrow,
  ArrowType(..),
  ShadowType(..),
  arrowNew,
  arrowSet
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new arrow with display options.
--
arrowNew :: ArrowType -> ShadowType -> IO Arrow
arrowNew at st = makeNewObject mkArrow $ liftM castPtr $ 
  {#call unsafe arrow_new#} ((fromIntegral.fromEnum) at) 
  ((fromIntegral.fromEnum) st)

-- | Change the visual appearance of this widget.
--
arrowSet :: ArrowClass a => a -> ArrowType -> ShadowType -> IO ()
arrowSet a at st = {#call arrow_set#} (toArrow a) ((fromIntegral.fromEnum) at)
  ((fromIntegral.fromEnum) st)


--- NEW FILE: SizeGroup.chs ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget SizeGroup
--
--  Author : Duncan Coutts
--  Created: 2 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--  documentation Copyright (c) 1995..2000 the GTK+ Team
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- SizeGroup provides a mechanism for grouping a number of widgets together so
-- they all request the same amount of space. This is typically useful when you
-- want a column of widgets to have the same size, but you can't use a "Table"
-- widget.
--

module Graphics.UI.Gtk.Misc.SizeGroup  (
  sizeGroupNew,
  SizeGroupMode(..),
  sizeGroupSetMode,
  sizeGroupGetMode,
  sizeGroupAddWidget,
  sizeGroupRemoveWidget
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GObject	(makeNewGObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

{#enum SizeGroupMode {underscoreToCase}#}

-- | Create a new SizeGroup.
--
sizeGroupNew :: SizeGroupMode -> IO SizeGroup
sizeGroupNew mode = makeNewGObject mkSizeGroup $
  {#call unsafe size_group_new#} ((fromIntegral.fromEnum) mode)

-- | Adds a widget to a SizeGroup. In the future, the requisition of the widget
-- will be determined as the maximum of its requisition and the requisition of
-- the other widgets in the size group. Whether this applies horizontally,
-- vertically, or in both directions depends on the mode of the size group. See
-- 'sizeGroupSetMode'.
--
sizeGroupAddWidget :: (SizeGroupClass obj, WidgetClass widget) => obj
                   -> widget -> IO ()
sizeGroupAddWidget obj widget =
  {#call size_group_add_widget#} (toSizeGroup obj) (toWidget widget)

-- | Gets the current mode of the size group.
--
sizeGroupGetMode :: SizeGroupClass obj => obj -> IO SizeGroupMode
sizeGroupGetMode obj = liftM (toEnum.fromIntegral) $
  {#call unsafe size_group_get_mode#} (toSizeGroup obj)

-- | Removes the widget from the SizeGroup.
--
sizeGroupRemoveWidget :: (SizeGroupClass obj, WidgetClass widget) => obj -> widget -> IO ()
sizeGroupRemoveWidget obj widget =
  {#call size_group_remove_widget#} (toSizeGroup obj) (toWidget widget)

-- | Sets the 'SizeGroupMode' of the size group. The mode of the size group
-- determines whether the widgets in the size group should all have the same
-- horizontal requisition 'sizeGroupModeHorizontal' all have the same vertical
-- requisition 'sizeGroupModeVertical', or should all have the same requisition
-- in both directions 'sizeGroupModeBoth'.
--
sizeGroupSetMode :: SizeGroupClass obj => obj -> SizeGroupMode -> IO ()
sizeGroupSetMode obj mode =
  {#call size_group_set_mode#} (toSizeGroup obj) ((fromIntegral.fromEnum) mode)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Misc Calendar.chs.pp,NONE,1.1 EventBox.chs.pp,NONE,1.1 Tooltips.chs.pp,NONE,1.1

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

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

Added Files:
	Calendar.chs.pp EventBox.chs.pp Tooltips.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Calendar.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Calendar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:27:47 $
--
--  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 shows a calendar.
--
module Graphics.UI.Gtk.Misc.Calendar (
  Calendar,
  CalendarClass,
  castToCalendar,
  calendarNew,
  calendarSelectMonth,
  calendarSelectDay,
  calendarMarkDay,
  calendarUnmarkDay,
  calendarClearMarks,
  calendarDisplayOptions,
#if GTK_CHECK_VERSION(2,4,0)
  calendarSetDisplayOptions,
  calendarGetDisplayOptions,
#endif
  calendarGetDate,
  onDaySelected,
  afterDaySelected,
  onDaySelectedDoubleClick,
  afterDaySelectedDoubleClick,
  onMonthChanged,
  afterMonthChanged,
  onNextMonth,
  afterNextMonth,
  onNextYear,
  afterNextYear,
  onPrevMonth,
  afterPrevMonth,
  onPrevYear,
  afterPrevYear
  ) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(CalendarDisplayOptions(..), fromFlags, toFlags)

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

-- methods

-- | Create a new calendar widget.
--
-- * No sensible date will be set.
--
calendarNew :: IO Calendar
calendarNew  = makeNewObject mkCalendar $ 
  liftM castPtr {#call unsafe calendar_new#}

-- | Flip the page to a month , 0 is January,.., 11
-- is December.
--
-- * Returns True if the operation succeeded.
--
calendarSelectMonth :: CalendarClass c => c -> Int -> Int -> IO Bool
calendarSelectMonth cal month year = liftM toBool $
  {#call calendar_select_month#} (toCalendar cal) (fromIntegral month)
  (fromIntegral year)

-- | Shift to a day, counted form 1 to 31 (depending
-- on the month of course).
--
calendarSelectDay :: CalendarClass c => c -> Int -> IO ()
calendarSelectDay cal day = 
  {#call calendar_select_day#} (toCalendar cal) (fromIntegral day)

-- | Mark (select) a day in the current month.
--
-- * Returns True if the argument was within bounds and the day was previously
--   deselected.
--
calendarMarkDay :: CalendarClass c => c -> Int -> IO Bool
calendarMarkDay cal day = liftM toBool $
  {#call calendar_mark_day#} (toCalendar cal) (fromIntegral day)

-- | Unmark (deselect) a day in the current month.
--
-- * Returns True if the argument was within bounds and the day was previously
--   selected.
--
calendarUnmarkDay :: CalendarClass c => c -> Int -> IO Bool
calendarUnmarkDay cal day = liftM toBool $
  {#call calendar_unmark_day#} (toCalendar cal) (fromIntegral day)

-- | Unmark every day in the current page.
--
calendarClearMarks :: CalendarClass c => c -> IO ()
calendarClearMarks cal = {#call calendar_clear_marks#} (toCalendar cal)

#if GTK_CHECK_VERSION(2,4,0)
-- | Specifies how the calendar should be displayed.
--
calendarSetDisplayOptions :: CalendarClass c => c
                          -> [CalendarDisplayOptions] -> IO ()
calendarSetDisplayOptions cal opts =
  {#call calendar_set_display_options#} (toCalendar cal)
    ((fromIntegral.fromFlags) opts)

-- | Returns the current display options for the calendar.
--
calendarGetDisplayOptions :: CalendarClass c => c
                          -> IO [CalendarDisplayOptions]
calendarGetDisplayOptions cal = liftM (toFlags.fromIntegral) $
  {#call calendar_get_display_options#} (toCalendar cal)

-- | Depreciaded, use 'calendarSetDisplayOptions'.
--
calendarDisplayOptions :: CalendarClass c => c
                       -> [CalendarDisplayOptions] -> IO ()
calendarDisplayOptions = calendarSetDisplayOptions
#else

-- | Specifies how the calendar should be displayed.
--
calendarDisplayOptions :: CalendarClass c => c -> [CalendarDisplayOptions] ->
                          IO ()
calendarDisplayOptions cal opts = {#call calendar_display_options#}
  (toCalendar cal) ((fromIntegral.fromFlags) opts)
#endif

-- | Retrieve the currently selected date.
--
-- * Returns (year, month, day) of the selection.
--
calendarGetDate :: CalendarClass c => c -> IO (Int,Int,Int)
calendarGetDate cal = alloca $ \yearPtr -> alloca $ \monthPtr -> 
  alloca $ \dayPtr -> do
    {#call unsafe calendar_get_date#} (toCalendar cal) yearPtr monthPtr dayPtr
    year  <- liftM fromIntegral $ peek yearPtr
    month <- liftM fromIntegral $ peek monthPtr
    day	  <- liftM fromIntegral	$ peek dayPtr
    return (year,month,day)

-- | Freeze the calender for several update operations.
--
calendarFreeze :: CalendarClass c => c -> IO a -> IO a
calendarFreeze cal update = do
  {#call unsafe calendar_freeze#} (toCalendar cal)
  res <- update
  {#call calendar_thaw#} (toCalendar cal)
  return res

-- signals

-- | Emitted when a day was selected.
--
onDaySelected, afterDaySelected :: CalendarClass c => c -> IO () ->
                                   IO (ConnectId c)
onDaySelected = connect_NONE__NONE "day-selected" False
afterDaySelected = connect_NONE__NONE "day-selected" True

-- | Emitted when a day received a
-- double click.
--
onDaySelectedDoubleClick, afterDaySelectedDoubleClick :: CalendarClass c => 
                                                         c -> IO () ->
                                                         IO (ConnectId c)
onDaySelectedDoubleClick = 
  connect_NONE__NONE "day-selected-double-click" False
afterDaySelectedDoubleClick = 
  connect_NONE__NONE "day-selected-double-click" True

-- | The month changed.
--
onMonthChanged, afterMonthChanged :: CalendarClass c => c -> IO () ->
                                     IO (ConnectId c)
onMonthChanged = connect_NONE__NONE "month-changed" False
afterMonthChanged = connect_NONE__NONE "month-changed" True

-- | The next month was selected.
--
onNextMonth, afterNextMonth :: CalendarClass c => c -> IO () ->
                               IO (ConnectId c)
onNextMonth = connect_NONE__NONE "next-month" False
afterNextMonth = connect_NONE__NONE "next-month" True

-- | The next year was selected.
--
onNextYear, afterNextYear :: CalendarClass c => c -> IO () -> IO (ConnectId c)
onNextYear = connect_NONE__NONE "next-year" False
afterNextYear = connect_NONE__NONE "next-year" True

-- | The previous month was selected.
--
onPrevMonth, afterPrevMonth :: CalendarClass c => c -> IO () ->
                               IO (ConnectId c)
onPrevMonth = connect_NONE__NONE "prev-month" False
afterPrevMonth = connect_NONE__NONE "prev-month" True

-- | The previous year was selected.
--
onPrevYear, afterPrevYear :: CalendarClass c => c -> IO () -> IO (ConnectId c)
onPrevYear = connect_NONE__NONE "prev-year" False
afterPrevYear = connect_NONE__NONE "prev-year" True

  

--- NEW FILE: EventBox.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget EventBox
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:27:48 $
--
--  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 container can be used to receive 'Event's for a widget
-- that has no window on its own.
--
-- TODO
--
-- * check: Is this widget useful?
--
module Graphics.UI.Gtk.Misc.EventBox (
  EventBox,
  EventBoxClass,
  castToEventBox,
  eventBoxNew
#if GTK_CHECK_VERSION(2,4,0)
 ,eventBoxSetVisibleWindow,
  eventBoxGetVisibleWindow,
  eventBoxSetAboveChild,
  eventBoxGetAboveChild
#endif
  ) where

import Monad	(liftM)

import System.Glib.FFI
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 'EventBox'.
--
eventBoxNew :: IO EventBox
eventBoxNew  = makeNewObject mkEventBox $ 
  liftM castPtr {#call unsafe event_box_new#}

#if GTK_CHECK_VERSION(2,4,0)
-- | Set whether the event box uses a visible or invisible child window. The
-- default is to use visible windows. The C documentation for details of what
-- difference this makes.
--
eventBoxSetVisibleWindow :: EventBox -> Bool -> IO ()
eventBoxSetVisibleWindow ebox visible =
  {#call event_box_set_visible_window#} ebox (fromBool visible)

-- | Returns whether the event box has a visible window.
--
eventBoxGetVisibleWindow :: EventBox -> IO Bool
eventBoxGetVisibleWindow ebox =
  liftM toBool $ {#call unsafe event_box_get_visible_window#} ebox

-- | Set whether the event box window is positioned above the windows of its
-- child, as opposed to below it. 
--
-- * If the window is above, all events inside the event box will go to the
-- event box. If the window is below, events in windows of child widgets will
-- first got to that widget, and then to its parents.
--
eventBoxSetAboveChild :: EventBox -> Bool -> IO ()
eventBoxSetAboveChild ebox above =
  {#call event_box_set_above_child#} ebox (fromBool above)

-- | Returns whether the event box window is above or below the windows of its
-- child. See 'eventBoxSetAboveChild' for details.
--
eventBoxGetAboveChild :: EventBox -> IO Bool
eventBoxGetAboveChild ebox =
  liftM toBool $ {#call unsafe event_box_get_above_child#} ebox
#endif

--- NEW FILE: Tooltips.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Tooltips
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:27:48 $
--
--  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.
--
-- |
--
-- 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'.
--
#ifndef DISABLE_DEPRECATED
-- 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.
--
#endif
-- 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'.
--
module Graphics.UI.Gtk.Misc.Tooltips (
  Tooltips,
  TooltipsClass,
  castToTooltips,
  tooltipsNew,
  tooltipsEnable,
  tooltipsDisable,
#ifndef DISABLE_DEPRECATED
  tooltipsSetDelay,
#endif
  tooltipsSetTip,
  tooltipsDataGet
  ) 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 goup of 'Tooltips'.
--
tooltipsNew :: IO Tooltips
tooltipsNew  = makeNewObject mkTooltips $ 
  liftM castPtr {#call unsafe tooltips_new#}

-- | Display the help the 'Tooltips' group
-- provides.
--
tooltipsEnable :: TooltipsClass t => t -> IO ()
tooltipsEnable t = {#call unsafe tooltips_enable#} (toTooltips t)

-- | Disable 'Tooltips' group.
--
-- * 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 t => t -> IO ()
tooltipsDisable t = {#call unsafe tooltips_disable#} (toTooltips t)

#ifndef DISABLE_DEPRECATED
-- | Sets the time between the user moving the mouse
-- over a widget and the widget's tooltip appearing.
--
-- * The @time@ parameter is in ms.
--
tooltipsSetDelay :: TooltipsClass t => t -> Int -> IO ()
tooltipsSetDelay t time = {#call unsafe tooltips_set_delay#}
  (toTooltips t) (fromIntegral time)
#endif

-- | Adds a tooltip containing the message tipText to
-- the specified GtkWidget.
--
-- * The @tipPrivate@ parameter is meant to give a thorough
--   explaination. This might someday be accessible to a questionmark cursor
--   (like MS Windows).
--
tooltipsSetTip :: (TooltipsClass t, WidgetClass w) => t -> w -> String ->
                  String -> IO ()
tooltipsSetTip t w tipText tipPrivate = 
  withUTFString tipPrivate $ \priPtr ->
  withUTFString tipText $ \txtPtr ->
  {#call unsafe tooltips_set_tip#} (toTooltips t) (toWidget w) txtPtr priPtr

{#pointer * TooltipsData#}

-- | Retrieves any 'Tooltips' previously associated with the given widget.
--
tooltipsDataGet :: WidgetClass w => w -> IO (Maybe (Tooltips, String, String))
tooltipsDataGet w = do
  tipDataPtr <- {#call unsafe tooltips_data_get#} (toWidget w)
  if tipDataPtr == nullPtr
    then return Nothing
    else do --next line is a hack, tooltips struct member is at offset 0
	   tooltips <- makeNewObject mkTooltips (return $ castPtr tipDataPtr)
           tipText  <- {#get TooltipsData->tip_text#} tipDataPtr
                   >>= peekUTFString
           tipPrivate <- {#get TooltipsData->tip_private#} tipDataPtr
                     >>= peekUTFString
           return $ Just $ (tooltips, tipText, tipPrivate)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar ImageMenuItem.chs,NONE,1.1 MenuBar.chs,NONE,1.1 MenuItem.chs,NONE,1.1

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

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

Added Files:
	ImageMenuItem.chs MenuBar.chs MenuItem.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: MenuBar.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget MenuBar
--
--  Author : Axel Simon
--          
--  Created: 21 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:27:03 $
--
--  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.
--
-- |
--

module Graphics.UI.Gtk.MenuComboToolbar.MenuBar (
  MenuBar,
  MenuBarClass,
  castToMenuBar,
  menuBarNew
  ) where

import Monad	(liftM)

import System.Glib.FFI
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 horizontal bar that contains menu items.
--
menuBarNew :: IO MenuBar
menuBarNew  = makeNewObject mkMenuBar $ 
  liftM castPtr {#call unsafe menu_bar_new#}

--- NEW FILE: ImageMenuItem.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ImageMenuItem
--
--  Author : Jonas Svensson
--          
--  Created: 12 Aug 2002
--
--  Version $Revision: 1.1 $
--
--  Copyright (c) 2002 Jonas Svensson
--
--  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 implements a 'MenuItem' with an image next to it 
--
-- TODO
--
-- * imageMenuItemNewFromSock should also have a AccelGroup argument
-- 

module Graphics.UI.Gtk.MenuComboToolbar.ImageMenuItem (
  ImageMenuItem,
  ImageMenuItemClass,
  imageMenuItemSetImage,
  imageMenuItemGetImage,
  imageMenuItemNew,
  imageMenuItemNewFromStock,
  imageMenuItemNewWithLabel,
  imageMenuItemNewWithMnemonic
  ) 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


-- | Sets the image for the ImageMenuItem.
--
imageMenuItemSetImage :: (ImageMenuItemClass imi,WidgetClass wd) =>
                         imi -> wd -> IO ()
imageMenuItemSetImage imi wd =
  {#call unsafe image_menu_item_set_image#} (toImageMenuItem imi) 
                                            (toWidget wd)

-- | Get the image that is currently set a the image.
--
imageMenuItemGetImage :: ImageMenuItemClass imi => imi -> IO (Maybe Widget)
imageMenuItemGetImage imi = do
   imPtr <- {#call unsafe image_menu_item_get_image#} (toImageMenuItem imi)
   if imPtr==nullPtr then return Nothing else do
     liftM Just $ makeNewObject mkWidget $ return imPtr

-- | Create a new 'MenuItem' with a image next to it.
--
imageMenuItemNew :: IO ImageMenuItem
imageMenuItemNew  = makeNewObject mkImageMenuItem $ liftM castPtr $
  {#call unsafe image_menu_item_new#}

-- | Create a new 'MenuItem' with a stock image.
--
imageMenuItemNewFromStock :: String -> IO ImageMenuItem
imageMenuItemNewFromStock str = withUTFString str $ \strPtr ->
  makeNewObject mkImageMenuItem $ liftM castPtr $ 
  {#call unsafe image_menu_item_new_from_stock#} strPtr
    (AccelGroup nullForeignPtr)

-- | Create a new 'MenuItem' with a label.
--
imageMenuItemNewWithLabel :: String -> IO ImageMenuItem
imageMenuItemNewWithLabel str = withUTFString str $ \strPtr ->
  makeNewObject mkImageMenuItem $ liftM castPtr $ 
  {#call unsafe image_menu_item_new_with_label#} strPtr

-- | Create a new 'MenuItem' with a label where underscored indicate the
-- mnemonic.
--
imageMenuItemNewWithMnemonic :: String -> IO ImageMenuItem
imageMenuItemNewWithMnemonic str = withUTFString str $ \strPtr ->
  makeNewObject mkImageMenuItem $ liftM castPtr $ 
  {#call unsafe image_menu_item_new_with_mnemonic#} strPtr

--- NEW FILE: MenuItem.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget MenuItem
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:27:03 $
--
--  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 represents a singe menu item.
--
-- * The widget derives from Item. Since CList and CTree are deprecated, it
--   is the only child of that widget. The three signals defined by Item are
--   therefore bound in this module.
--
-- TODO
--
-- * figure out what the signals \"toggle-size-allocate\" and 
--   \"toggle-size-request\" are good for and bind them if useful
--
-- * figure out if the connectToToggle signal is useful at all
--
module Graphics.UI.Gtk.MenuComboToolbar.MenuItem (
  MenuItem,
  MenuItemClass,
  castToMenuItem,
  menuItemNew,
  menuItemNewWithLabel,
  menuItemNewWithMnemonic,
  menuItemSetSubmenu,
  menuItemGetSubmenu,
  menuItemRemoveSubmenu,
  menuItemSelect,
  menuItemDeselect,
  menuItemActivate,
  menuItemSetRightJustified,
  menuItemGetRightJustified,
  menuItemSetAccelPath,
  onActivateLeaf,
  afterActivateLeaf,
  onActivateItem,
  afterActivateItem,
  onSelect,
  afterSelect,
  onDeselect,
  afterDeselect,
  onToggle,
  afterToggle
  ) 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 menu item. This is the smallest part
-- of a menu that the user can click on or select with the keyboard.
--
menuItemNew :: IO MenuItem
menuItemNew  = makeNewObject mkMenuItem $ 
  liftM castPtr {#call unsafe menu_item_new#}

-- | Create a new menu item and place a label inside.
--
menuItemNewWithLabel :: String -> IO MenuItem
menuItemNewWithLabel label = withUTFString label $ \strPtr -> 
  makeNewObject mkMenuItem $ liftM castPtr $
  {#call unsafe menu_item_new_with_label#} strPtr

-- | Create a new menu item and place a label inside. Underscores in the label
-- text indicate the mnemonic for the menu item.
--
menuItemNewWithMnemonic :: String -> IO MenuItem
menuItemNewWithMnemonic label = withUTFString label $ \strPtr -> 
  makeNewObject mkMenuItem $ liftM castPtr $
  {#call unsafe menu_item_new_with_mnemonic#} strPtr

-- | Set the item's submenu.
--
menuItemSetSubmenu :: (MenuItemClass mi, MenuClass m) => mi -> m -> IO ()
menuItemSetSubmenu mi submenu = 
  {#call menu_item_set_submenu#} (toMenuItem mi) (toWidget submenu)

-- | Gets the submenu underneath this menu item, if any.
--
menuItemGetSubmenu :: MenuItemClass mi => mi -> IO (Maybe Widget)
menuItemGetSubmenu mi = do
  wPtr <- {#call unsafe menu_item_get_submenu#} (toMenuItem mi)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget (return wPtr)

-- | Remove the item's submenu.
--
menuItemRemoveSubmenu :: MenuItemClass mi => mi -> IO ()
menuItemRemoveSubmenu mi = {#call menu_item_remove_submenu#} (toMenuItem mi)

-- | Select the menu item.
--
menuItemSelect :: MenuItemClass mi => mi -> IO ()
menuItemSelect mi = {#call menu_item_select#} (toMenuItem mi)

-- | Deselect the menu item.
--
menuItemDeselect :: MenuItemClass mi => mi -> IO ()
menuItemDeselect mi = {#call menu_item_deselect#} (toMenuItem mi)

-- | Simulate a click on the menu item.
--
menuItemActivate :: MenuItemClass mi => mi -> IO ()
menuItemActivate mi = {#call menu_item_activate#} (toMenuItem mi)

-- | Make the menu item right justified. Only useful for menu bars.
--
menuItemSetRightJustified :: MenuItemClass mi => mi -> Bool -> IO ()
menuItemSetRightJustified mi yes = 
  {#call menu_item_set_right_justified#} (toMenuItem mi) (fromBool yes)

-- | Gets whether the menu item appears justified at the right side of the menu
-- bar.
--
menuItemGetRightJustified :: MenuItemClass mi => mi -> IO Bool
menuItemGetRightJustified mi = liftM toBool $
  {#call unsafe menu_item_get_right_justified#} (toMenuItem mi)

-- | Set the accelerator path on the menu item, through which runtime changes of
-- the menu item's accelerator caused by the user can be identified and saved to
-- persistant storage (see 'accelMapSave' on this). To setup a default
-- accelerator for this menu item, call 'accelMapAddEntry' with the same accel
-- path. See also 'accelMapAddEntry' on the specifics of accelerator paths, and
-- 'menuSetAccelPath' for a more convenient variant of this function.
--
-- This function is basically a convenience wrapper that handles calling
-- 'widgetSetAccelPath' with the appropriate accelerator group for the menu
-- item.
--
-- * Note that you do need to set an accelerator on the parent menu with
-- 'menuSetAccelGroup' for this to work.
--
menuItemSetAccelPath :: MenuItemClass mi => mi -> Maybe String -> IO ()
menuItemSetAccelPath mi accelPath =
  maybeWith withCString accelPath $ \strPtr ->
  {#call menu_item_set_accel_path#} (toMenuItem mi) strPtr

-- signals

-- | The user has chosen the menu item and the item does not contain a submenu.
--
onActivateLeaf, afterActivateLeaf :: MenuItemClass mi => mi -> IO () ->
                                     IO (ConnectId mi)
onActivateLeaf = connect_NONE__NONE "activate" False
afterActivateLeaf = connect_NONE__NONE "activate" True

-- | Emitted when the user chooses this item even if it has submenus.
--
onActivateItem, afterActivateItem :: MenuItemClass mi => mi -> IO () ->
                                     IO (ConnectId mi)
onActivateItem = connect_NONE__NONE "activate-item" False
afterActivateItem = connect_NONE__NONE "activate-item" True

-- | This signal is emitted when the item is selected.
--
onSelect, afterSelect :: ItemClass i => i -> IO () -> IO (ConnectId i)
onSelect = connect_NONE__NONE "select" False
afterSelect = connect_NONE__NONE "select" True

-- | This signal is emitted when the item is deselected.
--
onDeselect, afterDeselect :: ItemClass i => i -> IO () -> IO (ConnectId i)
onDeselect = connect_NONE__NONE "deselect" False
afterDeselect = connect_NONE__NONE "deselect" True

-- | This signal is emitted when the item is toggled.
--
onToggle, afterToggle :: ItemClass i => i -> IO () -> IO (ConnectId i)
onToggle = connect_NONE__NONE "toggled" False
afterToggle = connect_NONE__NONE "toggled" True

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar TearoffMenuItem.chs,NONE,1.1 RadioMenuItem.chs,NONE,1.1 MenuShell.chs,NONE,1.1

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

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

Added Files:
	TearoffMenuItem.chs RadioMenuItem.chs MenuShell.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: MenuShell.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget MenuShell
--
--  Author : Axel Simon
--          
--  Created: 21 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:26:43 $
--
--  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.
--
-- |
--
-- An abstract base class which provides the control of navigation through
-- menu items.
--

module Graphics.UI.Gtk.MenuComboToolbar.MenuShell (
  MenuShell,
  MenuShellClass,
  castToMenuShell,
  menuShellAppend,
  menuShellPrepend,
  menuShellInsert,
  menuShellDeactivate,
  menuShellSelectItem,
  menuShellDeselect,
  onActivateCurrent,
  afterActivateCurrent,
  onCancel,
  afterCancel,
  onDeactivated,
  afterDeactivated,
  MenuDirectionType(..),
  onMoveCurrent,
  afterMoveCurrent,
  onSelectionDone,
  afterSelectionDone
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Append the new entry @child@ to a menu.
--
menuShellAppend :: (MenuShellClass ms, MenuItemClass w) => ms -> w -> IO ()
menuShellAppend ms child = 
  {#call menu_shell_append#} (toMenuShell ms) (toWidget child)

-- | Prepend the new entry @child@ to a menu.
--
menuShellPrepend :: (MenuShellClass ms, MenuItemClass w) => ms -> w -> IO ()
menuShellPrepend ms child = 
  {#call menu_shell_prepend#} (toMenuShell ms) (toWidget child)

-- | Insert the @child@ menu item at the
-- specified position (0..n-1).
--
menuShellInsert :: (MenuShellClass ms, MenuItemClass w) => ms -> w -> Int ->
                   IO ()
menuShellInsert ms child pos = {#call menu_shell_insert#} 
  (toMenuShell ms) (toWidget child) (fromIntegral pos)


-- | Temporary deactivate a complete menu
-- definition.
--
menuShellDeactivate :: MenuShellClass ms => ms -> IO ()
menuShellDeactivate ms = {#call menu_shell_deactivate#} (toMenuShell ms)

-- | Activate a specific item in the menu. If the
-- menu was deactivated and @force@ is set, the previously deactivated
-- menu is reactivated.
--
menuShellActivateItem :: (MenuShellClass ms, MenuItemClass w) => ms -> w ->
                         Bool -> IO ()
menuShellActivateItem ms child force = {#call menu_shell_activate_item#} 
  (toMenuShell ms) (toWidget child) (fromBool force)

-- | Select a specific item within the menu.
--
menuShellSelectItem :: (MenuShellClass ms, MenuItemClass w) => ms -> w -> IO ()
menuShellSelectItem ms child =
  {#call menu_shell_select_item#} (toMenuShell ms) (toWidget child)

-- | Deselect a the selected item within the menu.
--
menuShellDeselect :: MenuShellClass ms => ms -> IO ()
menuShellDeselect ms =
  {#call menu_shell_deselect#} (toMenuShell ms)

-- signals

-- | This signal is called if an item is
-- activated. The boolean flag @hide@ is True whenever the menu will
-- behidden after this action.
--
onActivateCurrent, afterActivateCurrent :: MenuShellClass ms => ms ->
                                           (Bool -> IO ()) ->
                                           IO (ConnectId ms)
onActivateCurrent = connect_BOOL__NONE "activate-current" False
afterActivateCurrent = connect_BOOL__NONE "activate-current" True

-- | This signal will be emitted when a selection is
-- aborted and thus does not lead to an activation. This is in contrast to the
-- @selection@ done signal which is always emitted.
--
onCancel, afterCancel :: MenuShellClass ms => ms -> IO () -> IO (ConnectId ms)
onCancel = connect_NONE__NONE "cancel" False
afterCancel = connect_NONE__NONE "cancel" True

-- | This signal is sent whenever the menu shell
-- is deactivated (hidden).
--
onDeactivated, afterDeactivated :: MenuShellClass ms => ms -> IO () ->
                                   IO (ConnectId ms)
onDeactivated = connect_NONE__NONE "deactivate" False
afterDeactivated = connect_NONE__NONE "deactivate" True

-- | This signal is emitted for each move the
-- cursor makes.
--
onMoveCurrent, afterMoveCurrent :: MenuShellClass ms => ms ->
                                   (MenuDirectionType -> IO ()) ->
                                   IO (ConnectId ms)
onMoveCurrent = connect_ENUM__NONE "move-current" False
afterMoveCurrent = connect_ENUM__NONE "move-current" True

-- | This signal is emitted when the user
-- finished using the menu. Note that this signal is emitted even if no menu
-- item was activated.
--
onSelectionDone, afterSelectionDone :: MenuShellClass ms => ms -> IO () ->
                                       IO (ConnectId ms)
onSelectionDone = connect_NONE__NONE "selection-done" False
afterSelectionDone = connect_NONE__NONE "selection-done" True

--- NEW FILE: TearoffMenuItem.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget TearoffMenuItem
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:26:43 $
--
--  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 TearoffMenuItem is a special GtkMenuItem which is used to tear off 
--   and reattach its menu. When its menu is shown normally, the 
--   TearoffMenuItem is drawn as a dotted line indicating that the menu can 
--   be torn off. Activating it causes its menu to be torn off and displayed 
--   in its own window as a tearoff menu. When its menu is shown as a tearoff 
--   menu, the TearoffMenuItem is drawn as a dotted line which has a left 
--   pointing arrow graphic indicating that the tearoff menu can be reattached.
--   Activating it will erase the tearoff menu window.
--

module Graphics.UI.Gtk.MenuComboToolbar.TearoffMenuItem (
  TearoffMenuItem,
  TearoffMenuItemClass,
  castToTearoffMenuItem,
  tearoffMenuItemNew
  ) where

import Monad	(liftM)

import System.Glib.FFI
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 tear off menu item.
--
tearoffMenuItemNew :: IO TearoffMenuItem
tearoffMenuItemNew  = makeNewObject mkTearoffMenuItem $ liftM castPtr
  {#call unsafe tearoff_menu_item_new#}


--- NEW FILE: RadioMenuItem.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget RadioMenuItem
--
--  Author : Axel Simon
--          
--  Created: 21 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:26:43 $
--
--  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.
--
-- |
--
-- * These are not the original Gtk functions as they involve handling a Gtk
--   owned GList. The interface is rather oriented towards the RadioButton
--   widget interface.
--
-- TODO

module Graphics.UI.Gtk.MenuComboToolbar.RadioMenuItem (
  RadioMenuItem,
  RadioMenuItemClass,
  castToRadioMenuItem,
  radioMenuItemNew,
  radioMenuItemNewWithLabel,
  radioMenuItemNewWithMnemonic,
  radioMenuItemNewJoinGroup,
  radioMenuItemNewJoinGroupWithLabel,
  radioMenuItemNewJoinGroupWithMnemonic,

  -- * Compatibilty aliases
  radioMenuItemNewFromWidget,
  radioMenuItemNewWithLabelFromWidget,
  radioMenuItemNewWithMnemonicFromWidget
  ) 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 radio menu item.
--
radioMenuItemNew :: IO RadioMenuItem
radioMenuItemNew  = makeNewObject mkRadioMenuItem $ liftM castPtr $
  {#call unsafe radio_menu_item_new#} nullPtr

-- | Create a new radio menu item with a label in it.
--
radioMenuItemNewWithLabel :: String -> IO RadioMenuItem
radioMenuItemNewWithLabel label = withUTFString label $ \strPtr ->
  makeNewObject mkRadioMenuItem $ liftM castPtr $
  {#call unsafe radio_menu_item_new_with_label#} nullPtr strPtr

-- | Create a new radio menu item with a label in it. Underscores in the label
-- string indicate the mnemonic for the menu item.
--
radioMenuItemNewWithMnemonic :: String -> IO RadioMenuItem
radioMenuItemNewWithMnemonic label = withUTFString label $ \strPtr ->
  makeNewObject mkRadioMenuItem $ liftM castPtr $
  {#call unsafe radio_menu_item_new_with_mnemonic#} nullPtr strPtr

-- | Create a new radio button and attach it to the group of another radio
-- button.
--
radioMenuItemNewJoinGroup :: RadioMenuItem -> IO RadioMenuItem
radioMenuItemNewJoinGroup rmi = do
  groupPtr <- {#call unsafe radio_menu_item_get_group#} rmi
  makeNewObject mkRadioMenuItem $ liftM castPtr $
    {#call unsafe radio_menu_item_new#} groupPtr

-- | Create a new radio button with a label and attach it to the group of
-- another radio button.
--
radioMenuItemNewJoinGroupWithLabel :: RadioMenuItem -> String ->
                                      IO RadioMenuItem
radioMenuItemNewJoinGroupWithLabel rmi label = do
  groupPtr <- {#call unsafe radio_menu_item_get_group#} rmi
  withUTFString label $ \strPtr -> 
    makeNewObject mkRadioMenuItem $ liftM castPtr $ 
    {#call unsafe radio_menu_item_new_with_label#} groupPtr strPtr

-- | Create a new radio button with a label and attach it to the group of
-- another radio button. Underscores in the label string indicate the mnemonic
-- for the menu item.
--
radioMenuItemNewJoinGroupWithMnemonic :: RadioMenuItem -> String ->
                                      IO RadioMenuItem
radioMenuItemNewJoinGroupWithMnemonic rmi label = do
  groupPtr <- {#call unsafe radio_menu_item_get_group#} rmi
  withUTFString label $ \strPtr -> 
    makeNewObject mkRadioMenuItem $ liftM castPtr $ 
    {#call unsafe radio_menu_item_new_with_mnemonic#} groupPtr strPtr

-- These were added in gtk 2.4, the above Join methods simulate them in earlier
-- versions. These aliases are here for compatibility.

-- | Alias for 'radioMenuItemNewJoinGroup'.
radioMenuItemNewFromWidget = radioMenuItemNewJoinGroup

-- | Alias for 'radioMenuItemNewJoinGroupWithLabel'.
radioMenuItemNewWithLabelFromWidget = radioMenuItemNewJoinGroupWithLabel

-- | Alias for 'radioMenuItemNewJoinGroupWithMnemonic'.
radioMenuItemNewWithMnemonicFromWidget = radioMenuItemNewJoinGroupWithMnemonic

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar OptionMenu.chs.pp,NONE,1.1 Menu.chs.pp,NONE,1.1 ComboBoxEntry.chs.pp,NONE,1.1 ComboBox.chs.pp,NONE,1.1 Combo.chs.pp,NONE,1.1 CheckMenuItem.chs.pp,NONE,1.1

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

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

Added Files:
	OptionMenu.chs.pp Menu.chs.pp ComboBoxEntry.chs.pp 
	ComboBox.chs.pp Combo.chs.pp CheckMenuItem.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: ComboBoxEntry.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget ComboBoxEntry
--
--  Author : Duncan Coutts
--  Created: 25 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A text entry field with a dropdown list
--
-- * Added in gtk 2.4
--
module Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry  (
#if GTK_CHECK_VERSION(2,4,0)
  ComboBoxEntryClass,
  ComboBoxEntry,
  comboBoxEntryNew,
  comboBoxEntryNewWithModel,
  comboBoxEntryNewText,
  comboBoxEntrySetTextColumn,
  comboBoxEntryGetTextColumn,
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)
import Monad	(liftM)

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

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


comboBoxEntryNew :: IO ComboBoxEntry
comboBoxEntryNew =
  makeNewObject mkComboBoxEntry $ liftM castPtr $
  {# call gtk_combo_box_entry_new #}

comboBoxEntryNewWithModel :: TreeModel -> Int -> IO ComboBoxEntry
comboBoxEntryNewWithModel model textColumn =
  makeNewObject mkComboBoxEntry $ liftM castPtr $
  {# call gtk_combo_box_entry_new_with_model #} model (fromIntegral textColumn)

comboBoxEntryNewText :: IO ComboBoxEntry
comboBoxEntryNewText =
  makeNewObject mkComboBoxEntry $ liftM castPtr $
  {# call gtk_combo_box_entry_new_text #}

comboBoxEntrySetTextColumn :: ComboBoxEntryClass combo => combo -> Int -> IO ()
comboBoxEntrySetTextColumn combo textColumn =
  {# call gtk_combo_box_entry_set_text_column #} (toComboBoxEntry combo)
    (fromIntegral textColumn)

comboBoxEntryGetTextColumn :: ComboBoxEntryClass combo => combo -> IO Int
comboBoxEntryGetTextColumn combo =
  liftM fromIntegral $ 
  {# call gtk_combo_box_entry_get_text_column #} (toComboBoxEntry combo)

#endif

--- NEW FILE: Menu.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Menu
--
--  Author : Axel Simon
--          
--  Created: 21 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:25:36 $
--
--  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 Menu is a vertically aligned set of options that can be selected. There
-- are two kinds: Those that are part of a 'MenuBar' and those 
-- that appear as a context menu (within the work space). 
--
-- TODO
--
-- * The following not bound functions might be useful:
--   menuSetAccelGroup, menuSetAccelGroup, menuReposition
--
-- * The function menuPopup at a specific position is difficult to bind:
--   The callback function that determines at which position the menu is
--   to be shown is keept after the call returns. Maybe we could destroy
--   this function pointer with a destory event?
--
module Graphics.UI.Gtk.MenuComboToolbar.Menu (
  Menu,
  MenuClass,
  castToMenu,
  menuNew,
  menuReorderChild,
  menuPopup,
  menuSetAccelGroup,
  menuGetAccelGroup,
  menuSetAccelPath,
  menuSetTitle,
  menuGetTitle,
  menuPopdown,
  menuReposition,
  menuGetActive,
  menuSetActive,
  menuSetTearoffState,
  menuGetTearoffState,
  menuAttachToWidget,
  menuDetach,
  menuGetAttachWidget,
#if GTK_CHECK_VERSION(2,2,0)
  menuSetScreen,
#endif
#if GTK_CHECK_VERSION(2,4,0)
  menuSetMonitor,
#endif
  ) where

import Monad	(liftM)
import Maybe  (fromMaybe)

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.Gdk.Events as Events (Event(Button), time, button)

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

-- methods

-- | Make an empty Menu.
--
menuNew :: IO Menu
menuNew = makeNewObject mkMenu $
  liftM castPtr {#call unsafe menu_new#}

-- | Move a child to a new position within the menu.
--
-- * The position is counted from 0 to n-1 if the menu contains n entries.
--
menuReorderChild :: (MenuClass m, MenuItemClass mi) => m -> mi -> Int -> IO ()
menuReorderChild m child pos = {#call menu_reorder_child#}
  (toMenu m) (toWidget child) (fromIntegral pos)

-- | Popup a context menu where a button press occurred. 
--
--
menuPopup :: MenuClass m => m -> Event -> IO ()
menuPopup m (Events.Button { time=t, button=b }) = {#call menu_popup#}
  (toMenu m) (mkWidget nullForeignPtr) (mkWidget nullForeignPtr) nullFunPtr
  nullPtr ((fromIntegral.fromEnum) b) (fromIntegral t)
menuPopup _ _ = error "menuPopup: Button event expected."

-- | Set the "AccelGroup" which holds global accelerators for the menu. This
-- accelerator group needs to also be added to all windows that this menu is
-- being used in with 'windowAddAccelGroup', in order for those windows to
-- support all the accelerators contained in this group.
--
menuSetAccelGroup :: MenuClass m => m -> AccelGroup -> IO ()
menuSetAccelGroup m accel =
  {#call menu_set_accel_group#} (toMenu m) accel

-- | Gets the "AccelGroup" which holds global accelerators for the menu. See
-- 'menuSetAccelGroup'.
--
menuGetAccelGroup :: MenuClass m => m -> IO AccelGroup
menuGetAccelGroup m =
  makeNewGObject mkAccelGroup $
  {#call unsafe menu_get_accel_group#} (toMenu m)

-- | Sets an accelerator path for this menu from which accelerator paths for its
-- immediate children, its menu items, can be constructed. The main purpose of
-- this function is to spare the programmer the inconvenience of having to call
-- 'menuItemSetAccelPath' on each menu item that should support runtime user
-- changable accelerators. Instead, by just calling 'menuSetAccelPath' on their
-- parent, each menu item of this menu, that contains a label describing its
-- purpose, automatically gets an accel path assigned.
--
-- For example, a menu containing menu items \"New\" and \"Exit\", will, after
-- calling
--
-- > menu `menuSetAccelPath` "<Gnumeric-Sheet>/File"
--
-- assign its items the accel paths: \"<Gnumeric-Sheet>\/File\/New\" and
-- \"<Gnumeric-Sheet>\/File\/Exit\".
--
-- Assigning accel paths to menu items then enables the user to change their
-- accelerators at runtime. More details about accelerator paths and their
-- default setups can be found at 'accelMapAddEntry'.
--
menuSetAccelPath :: MenuClass m => m -> String -> IO ()
menuSetAccelPath m accelPath =
  withUTFString accelPath $ \strPtr ->
  {#call menu_set_accel_path#} (toMenu m) strPtr

-- | Set the title of the menu. It is displayed if the menu is shown as a
-- tearoff menu.
--
menuSetTitle :: MenuClass m => m -> String -> IO ()
menuSetTitle m title = withUTFString title $ \strPtr ->
  {#call unsafe menu_set_title#} (toMenu m) strPtr

-- | Returns the title of the menu, orNothing if the menu has no title set on
-- it.
--
menuGetTitle :: MenuClass m => m -> IO (Maybe String)
menuGetTitle m =
  {#call unsafe menu_get_title#} (toMenu m) >>= maybePeek peekUTFString

-- | Remove a context or tearoff menu from the screen.
--
menuPopdown :: MenuClass m => m -> IO ()
menuPopdown m = {#call menu_popdown#} (toMenu m)

-- | Repositions the menu according to its position function.
--
menuReposition :: MenuClass m => m -> IO ()
menuReposition m = {#call menu_reposition#} (toMenu m)

-- | Return the currently selected menu item.
--
menuGetActive :: MenuClass m => m -> IO MenuItem
menuGetActive m = makeNewObject mkMenuItem $
  throwIfNull "menuGetActive: menu contains no menu items." $
  liftM castPtr $ {#call menu_get_active#} (toMenu m)

-- | Select the @n@th item of the menu.
--
menuSetActive :: MenuClass m => m -> Int -> IO ()
menuSetActive m n = {#call menu_set_active#} (toMenu m) (fromIntegral n)

-- | Specify whether the menu is to be shown as a tearoff menu.
--
menuSetTearoffState :: MenuClass m => m -> Bool -> IO ()
menuSetTearoffState m tornOff =
  {#call menu_set_tearoff_state#} (toMenu m) (fromBool tornOff)

-- | Returns whether the menu is torn off.
--
menuGetTearoffState :: MenuClass m => m -> IO Bool
menuGetTearoffState m = liftM toBool $
  {#call unsafe menu_get_tearoff_state#} (toMenu m)

-- | Attach this menu to another widget.
--
menuAttachToWidget :: (MenuClass m, WidgetClass w) => m -> w -> IO ()
menuAttachToWidget m w =
  {#call menu_attach_to_widget#} (toMenu m) (toWidget w) nullFunPtr

-- | Detach this menu from the widget it is attached to.
--
menuDetach :: MenuClass m => m -> IO ()
menuDetach m = {#call menu_detach#} (toMenu m)

-- | Get the widget this menu is attached to. Returns Nothing if this is a
-- tearoff (context) menu.
--
menuGetAttachWidget :: MenuClass m => m -> IO (Maybe Widget)
menuGetAttachWidget m = do
  wPtr <- {#call unsafe menu_get_attach_widget#} (toMenu m)
  if wPtr==nullPtr then return Nothing else liftM Just $ 
    makeNewObject mkWidget (return wPtr)

#if GTK_CHECK_VERSION(2,2,0)
-- | Sets the "Screen" on which the menu will be displayed.
--
menuSetScreen :: MenuClass m => m -> Maybe Screen -> IO ()
menuSetScreen m screen =
  {#call menu_set_screen#} (toMenu m)
    (fromMaybe (Screen nullForeignPtr) screen)

#endif
#if GTK_CHECK_VERSION(2,4,0)
-- | Informs GTK+ on which monitor a menu should be popped up.
--
menuSetMonitor :: MenuClass m => m
               -> Int -- ^ The number of the monitor on which the menu
                      --   should be popped up
               -> IO ()
menuSetMonitor m monitorNum =
  {#call menu_set_monitor#} (toMenu m) (fromIntegral monitorNum)
#endif

--- NEW FILE: ComboBox.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) entry Widget ComboBox
--
--  Author : Duncan Coutts
--  Created: 25 April 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- A widget used to choose from a list of items.
--
-- * Added in Gtk 2.4
--
module Graphics.UI.Gtk.MenuComboToolbar.ComboBox  (
#if GTK_CHECK_VERSION(2,4,0)
  ComboBoxClass,
  ComboBox,
  comboBoxNew,
  comboBoxNewWithModel,
  comboBoxSetWrapWidth,
  comboBoxSetRowSpanColumn,
  comboBoxSetColumnSpanColumn,
  comboBoxGetActive,
  comboBoxSetActive,
  comboBoxGetActiveIter,
  comboBoxSetActiveIter,
  comboBoxGetModel,
  comboBoxSetModel,
  comboBoxNewText,
  comboBoxAppendText,
  comboBoxInsertText,
  comboBoxPrependText,
  comboBoxRemoveText,
  comboBoxPopup,
  comboBoxPopdown
#endif
) where

#if GTK_CHECK_VERSION(2,4,0)

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.TreeList.TreeModel#} (TreeIter(..), createTreeIter)

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


comboBoxNew :: IO ComboBox
comboBoxNew =
  makeNewObject mkComboBox $ liftM castPtr $
  {# call gtk_combo_box_new #}

comboBoxNewWithModel :: TreeModel -> IO ComboBox
comboBoxNewWithModel model =
  makeNewObject mkComboBox $ liftM castPtr $
  {# call gtk_combo_box_new_with_model #} model

comboBoxSetWrapWidth :: ComboBoxClass combo => combo -> Int -> IO ()
comboBoxSetWrapWidth combo width =
  {# call gtk_combo_box_set_wrap_width #} (toComboBox combo)
    (fromIntegral width)

comboBoxSetRowSpanColumn :: ComboBoxClass combo => combo -> Int -> IO ()
comboBoxSetRowSpanColumn combo rowSpan =
  {# call gtk_combo_box_set_row_span_column #} (toComboBox combo)
    (fromIntegral rowSpan)

comboBoxSetColumnSpanColumn :: ComboBoxClass combo => combo -> Int -> IO ()
comboBoxSetColumnSpanColumn combo columnSpan =
  {# call gtk_combo_box_set_column_span_column #} (toComboBox combo)
    (fromIntegral columnSpan)

comboBoxGetActive :: ComboBoxClass combo => combo -> IO (Maybe Int)
comboBoxGetActive combo = do
  index <- {# call gtk_combo_box_get_active #} (toComboBox combo)
  if index == -1 then return Nothing
                 else return (Just $ fromIntegral index)

comboBoxSetActive :: ComboBoxClass combo => combo -> Int -> IO ()
comboBoxSetActive combo index =
  {# call gtk_combo_box_set_active #} (toComboBox combo)
    (fromIntegral index)

comboBoxGetActiveIter :: ComboBoxClass combo => combo -> IO (Maybe TreeIter)
comboBoxGetActiveIter combo =
  allocaBytes {# sizeof TreeIter #} $ \iterPtr -> do
  iter <- createTreeIter iterPtr
  wasSet <- liftM toBool $ {# call gtk_combo_box_get_active_iter #}
              (toComboBox combo) iter
  if wasSet then return (Just iter)
            else return Nothing

comboBoxSetActiveIter :: ComboBoxClass combo => combo -> TreeIter -> IO ()
comboBoxSetActiveIter combo iter =
  {# call gtk_combo_box_set_active_iter #} (toComboBox combo) iter

comboBoxGetModel :: ComboBoxClass combo => combo -> IO (Maybe TreeModel)
comboBoxGetModel combo = do
  modelPtr <- {# call gtk_combo_box_get_model #} (toComboBox combo)
  if modelPtr == nullPtr
    then return Nothing
    else liftM Just $ makeNewGObject mkTreeModel (return modelPtr)

comboBoxSetModel :: ComboBoxClass combo => combo -> TreeModel -> IO ()
comboBoxSetModel combo model =
  {# call gtk_combo_box_set_model #} (toComboBox combo) model

comboBoxNewText :: IO ComboBox
comboBoxNewText =
  makeNewObject mkComboBox $ liftM castPtr $
  {# call gtk_combo_box_new_text #}

comboBoxAppendText :: ComboBoxClass combo => combo -> String -> IO ()
comboBoxAppendText combo text =
  withUTFString text $ \strPtr ->
  {# call gtk_combo_box_append_text #} (toComboBox combo) strPtr

comboBoxInsertText :: ComboBoxClass combo => combo -> Int -> String -> IO ()
comboBoxInsertText combo index text =
  withUTFString text $ \strPtr ->
  {# call gtk_combo_box_insert_text #} (toComboBox combo)
    (fromIntegral index) strPtr

comboBoxPrependText :: ComboBoxClass combo => combo -> String -> IO ()
comboBoxPrependText combo text =
    withUTFString text $ \strPtr ->
  {# call gtk_combo_box_prepend_text #} (toComboBox combo) strPtr

comboBoxRemoveText :: ComboBoxClass combo => combo -> Int -> IO ()
comboBoxRemoveText combo index =
  {# call gtk_combo_box_remove_text #} (toComboBox combo) (fromIntegral index)

comboBoxPopup :: ComboBoxClass combo => combo -> IO ()
comboBoxPopup combo =
  {# call gtk_combo_box_popup #} (toComboBox combo)

comboBoxPopdown :: ComboBoxClass combo => combo -> IO ()
comboBoxPopdown combo =
  {# call gtk_combo_box_popdown #} (toComboBox combo)

#endif

--- NEW FILE: Combo.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Combo
--
--  Author : Axel Simon
--          
--  Created: 2 June 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:25:36 $
--
--  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 Combo box is a text entry field with a drop down list of predefined
-- alternatives.
--
-- * The Combo widget allows to insert arbitrary widgets as alternatives. Due
--   to the deprecated ListItem object we currently make no use of this 
--   feature.
--
-- TODO
--
-- * The combo_set_item_string function is not bound as we do not handle
--   arbitrary widgets yet.
--
module Graphics.UI.Gtk.MenuComboToolbar.Combo (
#ifndef DISABLE_DEPRECATED
  Combo,
  ComboClass,
  castToCombo,
  comboNew,
  comboSetPopdownStrings,
  comboSetValueInList,
  comboSetUseArrows,
  comboSetUseArrowsAlways,
  comboSetCaseSensitive,
  comboDisableActivate
#endif
  ) where
#ifndef DISABLE_DEPRECATED

import Monad	(liftM, mapM_)

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.UI.Gtk.Abstract.Object		(makeNewObject)
import Graphics.UI.Gtk.Abstract.Widget		(widgetShow)
import Graphics.UI.Gtk.Abstract.Container	(containerAdd)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs		(comboGetList)

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

-- methods

-- Create a new Combo text entry field.
--
comboNew :: IO Combo
comboNew = makeNewObject mkCombo $ liftM castPtr $ {#call unsafe combo_new#}

-- | Insert a set of Strings into the
-- 'Combo' drop down list.
--
comboSetPopdownStrings :: ComboClass c => c -> [String] -> IO ()
comboSetPopdownStrings c strs = do
  list <- comboGetList (toCombo c)
  {#call list_clear_items#} list  0 (-1)
  mapM_ (\str -> do
    li <- makeNewObject mkWidget $ liftM castPtr $ 
      withUTFString str {#call unsafe list_item_new_with_label#}
    widgetShow li
    containerAdd list li)
    strs

-- | Specify whether the user may enter texts that
-- are not in the list of alternatives and if empty entries are allowed.
--
comboSetValueInList :: ComboClass c => c -> Bool -> Bool -> IO ()
comboSetValueInList c val okIfEmpty = {#call unsafe combo_set_value_in_list#}
  (toCombo c) (fromBool val) (fromBool okIfEmpty)

-- | Specify if the user may use the cursor keys to
-- navigate the list.
--
comboSetUseArrows :: ComboClass c => c -> Bool -> IO ()
comboSetUseArrows c val = {#call unsafe combo_set_use_arrows#} (toCombo c)
  (fromBool val)

-- | Specify if the content entered by the user
-- will be replaced by a predefined alternative as soon as the user uses the
-- cursor keys.
--
comboSetUseArrowsAlways :: ComboClass c => c -> Bool -> IO ()
comboSetUseArrowsAlways c val = {#call unsafe combo_set_use_arrows_always#}
  (toCombo c) (fromBool val)

-- | Specify whether the entered text is case
-- sensitive when it comes to matching the users input with the predefined
-- alternatives.
--
comboSetCaseSensitive :: ComboClass c => c -> Bool -> IO ()
comboSetCaseSensitive c val = {#call unsafe combo_set_case_sensitive#}
  (toCombo c) (fromBool val)

-- | Stops the GtkCombo widget from showing the
-- popup list when the Entry emits the \"activate\" signal, i.e. when the Return
-- key is pressed. This may be useful if, for example, if you want the Return
-- key to close a dialog instead.
--
comboDisableActivate :: ComboClass c => c -> IO ()
comboDisableActivate  = {#call unsafe combo_disable_activate#}.toCombo

#endif

--- NEW FILE: CheckMenuItem.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget CheckMenuItem
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:25:36 $
--
--  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 implements a 'MenuItem' with a check next to it.
--
module Graphics.UI.Gtk.MenuComboToolbar.CheckMenuItem (
  CheckMenuItem,
  CheckMenuItemClass,
  checkMenuItemNew,
  checkMenuItemNewWithLabel,
  checkMenuItemNewWithMnemonic,
  checkMenuItemSetActive,
  checkMenuItemGetActive,
  checkMenuItemToggled,
  checkMenuItemSetInconsistent,
  checkMenuItemGetInconsistent
#if GTK_CHECK_VERSION(2,4,0)
 ,checkMenuItemGetDrawAsRadio,
  checkMenuItemSetDrawAsRadio
#endif
  ) 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 'MenuItem' with a check next to it.
--
checkMenuItemNew :: IO CheckMenuItem
checkMenuItemNew  = makeNewObject mkCheckMenuItem $ liftM castPtr $
  {#call unsafe check_menu_item_new#}

-- | Create a new 'CheckMenuItem' with a 'Label' inside.
--
checkMenuItemNewWithLabel :: String -> IO CheckMenuItem
checkMenuItemNewWithLabel str = withUTFString str $ \strPtr ->
  makeNewObject mkCheckMenuItem $ liftM castPtr $
  {#call unsafe check_menu_item_new_with_label#} strPtr

-- | Create a new 'CheckMenuItem' with a 'Label' inside. Underscores in the
-- label string indicate the mnemonic for the menu item.
--
checkMenuItemNewWithMnemonic :: String -> IO CheckMenuItem
checkMenuItemNewWithMnemonic str =
  withUTFString str $ \strPtr ->
  makeNewObject mkCheckMenuItem $ liftM castPtr $
  {#call unsafe check_menu_item_new_with_mnemonic#} strPtr

-- | Sets the active state of the menu item's check box.
--
checkMenuItemSetActive :: CheckMenuItemClass mi => mi -> Bool -> IO ()
checkMenuItemSetActive mi active = {#call check_menu_item_set_active#}
  (toCheckMenuItem mi) (fromBool active)

-- | Returns whether the check menu item is active.
--
checkMenuItemGetActive :: CheckMenuItemClass mi => mi -> IO Bool
checkMenuItemGetActive mi =
  liftM toBool $ {#call unsafe check_menu_item_get_active#} (toCheckMenuItem mi)

-- | Emits the toggled signal.
--
checkMenuItemToggled :: CheckMenuItemClass mi => mi -> IO ()
checkMenuItemToggled mi =
  {#call check_menu_item_toggled#} (toCheckMenuItem mi)

-- | Set the state of the menu item check to \`inconsistent'.
--
checkMenuItemSetInconsistent :: CheckMenuItemClass mi => mi -> Bool -> IO ()
checkMenuItemSetInconsistent mi inconsistent = 
  {#call check_menu_item_set_inconsistent#} (toCheckMenuItem mi) 
    (fromBool inconsistent)

-- | Query if the menu check is inconsistent (inbetween).
--
checkMenuItemGetInconsistent :: CheckMenuItemClass mi => mi -> IO Bool
checkMenuItemGetInconsistent mi = liftM toBool $
  {#call unsafe check_menu_item_get_inconsistent#} (toCheckMenuItem mi)

#if GTK_CHECK_VERSION(2,4,0)
-- | Sets whether the menu item is drawn like a 'RadioMenuItem'.
--
checkMenuItemSetDrawAsRadio :: CheckMenuItemClass mi => mi -> Bool -> IO ()
checkMenuItemSetDrawAsRadio mi asRadio =
  {#call check_menu_item_set_draw_as_radio#} (toCheckMenuItem mi)
    (fromBool asRadio)

-- | Returns whether the menu item is drawn like a 'RadioMenuItem'.
--
checkMenuItemGetDrawAsRadio :: CheckMenuItemClass mi => mi -> IO Bool
checkMenuItemGetDrawAsRadio mi = liftM toBool $
  {#call unsafe check_menu_item_get_draw_as_radio#} (toCheckMenuItem mi)
#endif


--- NEW FILE: OptionMenu.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget OptionMenu
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:25:36 $
--
--  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.
--
-- |
--
module Graphics.UI.Gtk.MenuComboToolbar.OptionMenu (
#ifndef DISABLE_DEPRECATED
  OptionMenu,
  OptionMenuClass,
  castToOptionMenu,
  optionMenuNew,
  optionMenuGetMenu,
  optionMenuSetMenu,
  optionMenuRemoveMenu,
  optionMenuSetHistory,
  optionMenuGetHistory,
  onOMChanged,
  afterOMChanged
#endif
  ) where
#ifndef DISABLE_DEPRECATED

import Monad	(liftM)

import System.Glib.FFI
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 option menu.
--
optionMenuNew :: IO OptionMenu
optionMenuNew  = makeNewObject mkOptionMenu $ 
  liftM castPtr {#call unsafe option_menu_new#}

-- | Get the menu that should be associated with this
-- option menu.
--
optionMenuGetMenu :: OptionMenuClass om => om -> IO Menu
optionMenuGetMenu om = makeNewObject mkMenu $ liftM castPtr $
  throwIfNull "optionMenuGetMenu: no menu associated with this option menu." $
  {#call unsafe option_menu_get_menu#} (toOptionMenu om)

-- | Set a menu to associate with this option menu.
--
optionMenuSetMenu :: (OptionMenuClass om, MenuClass m) => om -> m -> IO ()
optionMenuSetMenu om m = {#call option_menu_set_menu#}
  (toOptionMenu om) (toWidget m)

-- | Remove the association the menu.
--
optionMenuRemoveMenu :: OptionMenuClass om => om -> IO ()
optionMenuRemoveMenu om = 
  {#call unsafe option_menu_remove_menu#} (toOptionMenu om)

-- | Set the state of the option menu. The options
-- are numbered from 0 up to n-1 for the nth item.
--
optionMenuSetHistory :: OptionMenuClass om => om -> Int -> IO ()
optionMenuSetHistory om item = {#call option_menu_set_history#}
  (toOptionMenu om) (fromIntegral item)

-- | Retrieve the index of the selected item.
--
optionMenuGetHistory :: OptionMenuClass om => om -> IO Int
optionMenuGetHistory om = liftM fromIntegral $
  {#call unsafe option_menu_get_history#} (toOptionMenu om)

-- signals

-- | This signal is called if the selected option has changed.
--
onOMChanged, afterOMChanged :: OptionMenuClass om => om -> IO () ->
                               IO (ConnectId om)
onOMChanged = connect_NONE__NONE "changed" False
afterOMChanged = connect_NONE__NONE "changed" True

#endif

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/MenuComboToolbar Toolbar.chs.pp,NONE,1.1 ToolItem.chs.pp,NONE,1.1

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

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

Added Files:
	Toolbar.chs.pp ToolItem.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Toolbar.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Toolbar
--
--  Author : Axel Simon
--          
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:25:01 $
--
--  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.
--
{- | Create bars of buttons and other widgets.
 
  * This widget underwent a signficant overhaul in gtk 2.4 and the recommended
    api changed substantially. The old interface is still supported but it is
    not recommended.
 
  * The following information applies to the new interface only.
 
  A toolbar is created using 'toolbarNew'. A toolbar can contain instances of
  a subclass of "ToolItem". To add a "ToolItem" to the a toolbar, use
  'toolbarInsert'. To remove an item from the toolbar use 'containerRemove'.
  To add a button to the toolbar, add an instance of "ToolButton".
 
  Toolbar items can be visually grouped by adding instances of
  "SeparatorToolItem" to the toolbar. If a "SeparatorToolItem" has the
  \"expand\" property set to True and the \"draw\" property set to False the
  effect is to force all following items to the end of the toolbar.
 
  Creating a context menu for the toolbar can be done using
  'onPopupContextMenu'.
 
#ifndef DISABLE_DEPRECATED
  * The following information applies to the old interface only.
 
  'Button's, 'RadioButton's and 'ToggleButton's can be added by refering to
  stock images. Their size can be changed by calling 'toolbarSetIconSize'. In
  contrast, normal widget cannot be added. Due to the bad interface of
  GtkToolbar mnemonics of 'RadioButton's and 'ToggleButton's are not honored.
 
  All the append, insert and prepend functions use an internal function to
  do the actual work. In fact the interface is pretty skrewed up: To insert
  icons by using stock items is definitely the best practice as all other
  images cannot react to 'toolbarSetIconSize' and other theming actions. On
  the other hand 'toolbarInsertStock' always generates simple 'Button's
  but is the only function that is able to insert 'Mnemonic's on the label.
  Our solution is to use 'StockItem's to specify all 'Images' of the
  'Buttons'. If the user inserts 'RadioButton's or 'ToggleButton's, the stock
  image lookup is done manually. A mnemonic in the labels is sadly not
  honored this way.
#endif
-}
module Graphics.UI.Gtk.MenuComboToolbar.Toolbar (
  Toolbar,
  ToolbarClass,
  castToToolbar,
  Orientation(..),
  ToolbarStyle(..),
  toolbarNew,
#ifndef DISABLE_DEPRECATED
  toolbarInsertNewButton,
  toolbarAppendNewButton,
  toolbarPrependNewButton,
  toolbarInsertNewToggleButton,
  toolbarAppendNewToggleButton,
  toolbarPrependNewToggleButton,
  toolbarInsertNewRadioButton,
  toolbarAppendNewRadioButton,
  toolbarPrependNewRadioButton,
  toolbarInsertNewWidget,
  toolbarAppendNewWidget,
  toolbarPrependNewWidget,
#endif
  toolbarSetOrientation,
  toolbarGetOrientation,
  toolbarSetStyle,
  toolbarGetStyle,
  toolbarUnsetStyle,
  toolbarSetTooltips,
  toolbarGetTooltips,
  IconSize,
  iconSizeInvalid,
  iconSizeSmallToolbar,
  iconSizeLargeToolbar,
#ifndef DISABLE_DEPRECATED
  toolbarSetIconSize,
#endif
  toolbarGetIconSize,
#if GTK_CHECK_VERSION(2,4,0)
  toolbarInsert,
  toolbarGetItemIndex,
  toolbarGetNItems,
  toolbarGetNthItem,
  toolbarGetDropIndex,
  toolbarSetDropHighlightItem,
  toolbarSetShowArrow,
  toolbarGetShowArrow,
  ReliefStyle(..),
  toolbarGetReliefStyle,
#endif
  onOrientationChanged,
  afterOrientationChanged,
  onStyleChanged,
  afterStyleChanged,
  onPopupContextMenu,
  afterPopupContextMenu
  ) where

import Monad	(liftM)
import Maybe	(fromJust, fromMaybe)

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	(Orientation(..), ToolbarStyle(..),
					 ReliefStyle(..))
import Graphics.UI.Gtk.General.Structs	(
#ifndef DISABLE_DEPRECATED
					 toolbarChildToggleButton,
					 toolbarChildRadioButton,
#endif
					 IconSize, iconSizeInvalid,
					 iconSizeSmallToolbar,
					 iconSizeLargeToolbar)
import Graphics.UI.Gtk.General.StockItems	(stockLookupItem, siLabel, stockMissingImage)
import Graphics.UI.Gtk.Display.Image	(imageNewFromStock)

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

-- methods

-- | Create a new, empty toolbar.
--
toolbarNew :: IO Toolbar
toolbarNew  = makeNewObject mkToolbar $ liftM castPtr
  {#call unsafe toolbar_new#}

-- Make tooltips or not? 
--
mkToolText :: Maybe (String,String) -> (CString -> CString -> IO a) -> IO a
mkToolText Nothing               fun = fun nullPtr nullPtr
mkToolText (Just (text,private)) fun = withUTFString text $ \txtPtr -> 
  withUTFString private $ \prvPtr -> fun txtPtr prvPtr

#ifndef DISABLE_DEPRECATED
-- | Insert a new 'Button' into the 'Toolbar'.
--
-- * The new 'Button' is created at position @pos@, counting
--   from 0.
--
-- * The icon and label for the button is referenced by @stockId@
--   which must be a valid entry in the 'Toolbar's Style or the
--   default 'IconFactory'.
--
-- * If you whish to have 'Tooltips' added to this button you can
--   specify @Just (tipText, tipPrivate)@ , otherwise specify
--   @Nothing@.
--
-- * The newly created 'Button' is returned. Use this button to 
--   add an action function with @\"connectToClicked\"@.
--
toolbarInsertNewButton :: ToolbarClass tb => tb -> Int -> String ->
                          Maybe (String,String) -> IO Button
toolbarInsertNewButton tb pos stockId tooltips = 
  withUTFString stockId $ \stockPtr ->
  mkToolText tooltips $ \textPtr privPtr ->
  makeNewObject mkButton $ liftM castPtr $ 
  {#call unsafe toolbar_insert_stock#} (toToolbar tb) stockPtr textPtr privPtr
    nullFunPtr nullPtr (fromIntegral pos)

-- | Append a new 'Button' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
toolbarAppendNewButton :: ToolbarClass tb => tb -> String ->
                          Maybe (String,String) -> IO Button
toolbarAppendNewButton tb = toolbarInsertNewButton tb (-1)

-- | Prepend a new 'Button' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
toolbarPrependNewButton :: ToolbarClass tb => tb -> String ->
                           Maybe (String,String) -> IO Button
toolbarPrependNewButton tb = toolbarInsertNewButton tb 0

-- | Insert a new 'ToggleButton' into the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
toolbarInsertNewToggleButton :: ToolbarClass tb => tb -> Int -> String ->
                                Maybe (String,String) -> IO ToggleButton
toolbarInsertNewToggleButton tb pos stockId tooltips = do
  mItem <- stockLookupItem stockId
  item <- case mItem of
    (Just item) -> return item
    Nothing	-> liftM fromJust $ stockLookupItem stockMissingImage
  let label = (filter (/= '_')) $ siLabel item
  size <- toolbarGetIconSize (toToolbar tb)
  image <- imageNewFromStock stockId size
  makeNewObject mkToggleButton $ liftM castPtr $
    withUTFString label $ \lblPtr -> mkToolText tooltips $ \textPtr privPtr ->
    {#call unsafe toolbar_insert_element#} (toToolbar tb) 
    toolbarChildToggleButton (mkWidget nullForeignPtr) lblPtr 
    textPtr privPtr (toWidget image) nullFunPtr nullPtr (fromIntegral pos)

-- | Append a new 'ToggleButton' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
toolbarAppendNewToggleButton :: ToolbarClass tb => tb -> String ->
                                Maybe (String,String) -> IO ToggleButton
toolbarAppendNewToggleButton tb = toolbarInsertNewToggleButton tb (-1)

-- | Prepend a new 'ToggleButton' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
toolbarPrependNewToggleButton :: ToolbarClass tb => tb -> String ->
                                 Maybe (String,String) -> IO ToggleButton
toolbarPrependNewToggleButton tb = toolbarInsertNewToggleButton tb 0

-- | Insert a new 'RadioButton' into the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
-- * The @parent@ argument must be set to another
--   'RadioButton' in the group. If @Nothing@ is given, 
--   a new group is generated (which is the desired behavious for the
--   first button of a group).
--
toolbarInsertNewRadioButton :: (ToolbarClass tb, RadioButtonClass rb) => tb ->
                               Int -> String -> Maybe (String,String) ->
                               Maybe rb -> IO RadioButton
toolbarInsertNewRadioButton tb pos stockId tooltips rb = do
  mItem <- stockLookupItem stockId
  item <- case mItem of
    (Just item) -> return item
    Nothing	-> liftM fromJust $ stockLookupItem stockMissingImage
  let label = (filter (/= '_')) $ siLabel item
  size <- toolbarGetIconSize (toToolbar tb)
  image <- imageNewFromStock stockId size
  makeNewObject mkRadioButton $ liftM castPtr $
    withUTFString label $ \lblPtr -> mkToolText tooltips $ \textPtr privPtr ->
    {#call unsafe toolbar_insert_element#} (toToolbar tb) 
    toolbarChildRadioButton (maybe (mkWidget nullForeignPtr) toWidget rb) 
      lblPtr  textPtr privPtr (toWidget image) nullFunPtr nullPtr
      (fromIntegral pos)

-- | Append a new 'RadioButton' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
toolbarAppendNewRadioButton :: (ToolbarClass tb, RadioButtonClass rb) => tb ->
                               String -> Maybe (String,String) -> Maybe rb ->
                               IO RadioButton
toolbarAppendNewRadioButton tb = toolbarInsertNewRadioButton tb (-1)

-- | Prepend a new 'RadioButton' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
toolbarPrependNewRadioButton :: (ToolbarClass tb, RadioButtonClass rb) => tb ->
                                String -> Maybe (String,String) -> Maybe rb ->
                                IO RadioButton
toolbarPrependNewRadioButton tb = toolbarInsertNewRadioButton tb 0


-- | Insert an arbitrary widget to the 'Toolbar'.
--
-- * The 'Widget' should not be a button. Adding 'Button's
--   with the 'toolbarInsertButton',... functions with stock
--   objects is much better as it takes care of theme handling.
--
toolbarInsertNewWidget :: (ToolbarClass tb, WidgetClass w) => tb -> Int -> w ->
                          Maybe (String,String) -> IO ()
toolbarInsertNewWidget tb pos w tooltips = 
  mkToolText tooltips $ \textPtr privPtr ->
  {#call unsafe toolbar_insert_widget#} (toToolbar tb) (toWidget w)
    textPtr privPtr (fromIntegral pos)

-- | Append a new 'Widget' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
toolbarAppendNewWidget :: (ToolbarClass tb, WidgetClass w) => tb -> w ->
                          Maybe (String,String) -> IO ()
toolbarAppendNewWidget tb = toolbarInsertNewWidget tb (-1)

-- | Prepend a new 'Widget' to the 'Toolbar'.
--
-- * See 'toolbarInsertNewButton' for details.
--
-- * Mnemonics in the label of the 'StockItem' are removed as they do
--   not work due to the bad interface definition of GtkToolbar.
--
toolbarPrependNewWidget :: (ToolbarClass tb, WidgetClass w) => tb -> w ->
                           Maybe (String,String) -> IO ()
toolbarPrependNewWidget tb = toolbarInsertNewWidget tb 0
#endif


-- | Set the direction of the 'Toolbar'.
--
toolbarSetOrientation :: ToolbarClass tb => tb -> Orientation -> IO ()
toolbarSetOrientation tb orientation = {#call toolbar_set_orientation#}
  (toToolbar tb) ((fromIntegral.fromEnum) orientation)

-- | Get the direction of the 'Toolbar'.
--
toolbarGetOrientation :: ToolbarClass tb => tb -> IO Orientation
toolbarGetOrientation tb = liftM (toEnum.fromIntegral) $
  {#call unsafe toolbar_get_orientation#} (toToolbar tb)

-- | Alters the view of the toolbar to display either icons only, text only, or
-- both.
--
toolbarSetStyle :: ToolbarClass tb => tb -> ToolbarStyle -> IO ()
toolbarSetStyle tb style = {#call toolbar_set_style#}
  (toToolbar tb) ((fromIntegral.fromEnum) style)

-- | Retrieves whether the toolbar has text, icons, or both.
--
toolbarGetStyle :: ToolbarClass tb => tb -> IO ToolbarStyle
toolbarGetStyle tb = liftM (toEnum.fromIntegral) $
  {#call toolbar_get_style#} (toToolbar tb)

-- | Unsets a toolbar style set with 'toolbarSetStyle', so that user preferences
-- will be used to determine the toolbar style.
--
toolbarUnsetStyle :: ToolbarClass tb => tb -> IO ()
toolbarUnsetStyle tb =
  {#call toolbar_unset_style#} (toToolbar tb)

-- | Enable or disable the 'Tooltips'.
--
toolbarSetTooltips :: ToolbarClass tb => tb -> Bool -> IO ()
toolbarSetTooltips tb enable = {#call toolbar_set_tooltips#}
  (toToolbar tb) (fromBool enable)

-- | Enable or disable the 'Tooltips'.
--
toolbarGetTooltips :: ToolbarClass tb => tb -> IO Bool
toolbarGetTooltips tb =
  liftM toBool $ {#call unsafe toolbar_get_tooltips#} (toToolbar tb)

#ifndef DISABLE_DEPRECATED
-- | Set the size of the icons.
--
-- * It might be sensible to restrict oneself to 'IconSizeSmallToolbar' and
--   'IconSizeLargeToolbar'.
--
toolbarSetIconSize :: ToolbarClass tb => tb -> IconSize -> IO ()
toolbarSetIconSize tb is = {#call toolbar_set_icon_size#} (toToolbar tb)
  (fromIntegral is)
#endif

-- | Retrieve the current icon size that the 'Toolbar' shows.
--
toolbarGetIconSize :: ToolbarClass tb => tb -> IO IconSize
toolbarGetIconSize tb = liftM (toEnum.fromIntegral) $
  {#call unsafe toolbar_get_icon_size#} (toToolbar tb)

#if GTK_CHECK_VERSION(2,4,0)
-- | Insert a "ToolItem" into the toolbar at the given position.
--
-- * If the position is 0 the item is prepended to the start of the toolbar.
-- If the position is negative, the item is appended to the end of the toolbar.
--
toolbarInsert :: (ToolbarClass tb, ToolItemClass item) => tb
              -> item -> Int -> IO ()
toolbarInsert tb item pos =
  {#call toolbar_insert#} (toToolbar tb) (toToolItem item) (fromIntegral pos)

-- | Returns the position of item on the toolbar, starting from 0.
--
toolbarGetItemIndex :: (ToolbarClass tb, ToolItemClass item) => tb
                    -> item -> IO Int
toolbarGetItemIndex tb item = liftM fromIntegral $
  {#call unsafe toolbar_get_item_index#} (toToolbar tb) (toToolItem item)

-- | Returns the number of items on the toolbar.
--
toolbarGetNItems :: ToolbarClass tb => tb -> IO Int
toolbarGetNItems tb = liftM fromIntegral $
  {#call unsafe toolbar_get_n_items#} (toToolbar tb)

-- | Returns the n'th item on toolbar, or Nothing if the toolbar does not
-- contain an n'th item.
--
toolbarGetNthItem :: ToolbarClass tb => tb -> Int -> IO (Maybe ToolItem)
toolbarGetNthItem tb index = do
  toolItemPtr <- {#call unsafe toolbar_get_nth_item#} (toToolbar tb)
    (fromIntegral index)
  if toolItemPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkToolItem $ return toolItemPtr

-- | Returns the position corresponding to the indicated point on toolbar. This
-- is useful when dragging items to the toolbar: this function returns the
-- position a new item should be inserted.
--
-- * x and y are in toolbar coordinates.
--
toolbarGetDropIndex :: ToolbarClass tb => tb
                    -> (Int, Int)  -- ^ x,y coordinate of a point on the toolbar
                    -> IO Int
toolbarGetDropIndex tb (x,y) = liftM fromIntegral $
  {#call unsafe toolbar_get_drop_index#} (toToolbar tb)
    (fromIntegral x) (fromIntegral y)

-- | Highlights the toolbar to give an idea of what it would look like if item
-- was added to toolbar at the position indicated by the given index. If item is
-- Nothing, highlighting is turned off (and the index is ignored).
--
-- * Note: the ToolItem passed to this function must not be part of any widget
-- hierarchy. When an item is set as a drop highlight item it can not added to
-- any widget hierarchy or used as highlight item for another toolbar.
--
toolbarSetDropHighlightItem :: ToolbarClass tb => tb
                            -> Maybe ToolItem -- ^ A "ToolItem" or Nothing
                            -> Int            -- ^ A position on the toolbar
                            -> IO ()
toolbarSetDropHighlightItem tb item pos =
  {#call toolbar_set_drop_highlight_item#} (toToolbar tb)
    (fromMaybe (ToolItem nullForeignPtr) item) (fromIntegral pos)

-- | Sets whether to show an overflow menu when the toolbar doesn't have room
-- for all items on it.
--
toolbarSetShowArrow :: ToolbarClass tb => tb -> Bool -> IO ()
toolbarSetShowArrow tb showArrow =
  {#call toolbar_set_show_arrow#} (toToolbar tb) (fromBool showArrow)

-- | Returns whether the toolbar has an overflow menu.
--
toolbarGetShowArrow :: ToolbarClass tb => tb -> IO Bool
toolbarGetShowArrow tb = liftM toBool $
  {#call unsafe toolbar_get_show_arrow#} (toToolbar tb)

-- | Returns the relief style of buttons on the toolbar. See 'buttonSetRelief'.
--
toolbarGetReliefStyle :: ToolbarClass tb => tb -> IO ReliefStyle
toolbarGetReliefStyle tb = liftM (toEnum.fromIntegral) $
  {#call unsafe toolbar_get_relief_style#} (toToolbar tb)
#endif

-- signals

-- | Emitted when toolbarSetOrientation is called.
--
onOrientationChanged, afterOrientationChanged :: ToolbarClass tb => tb ->
                                                 (Orientation -> IO ()) ->
                                                 IO (ConnectId tb)
onOrientationChanged = connect_ENUM__NONE "orientation-changed" False
afterOrientationChanged = connect_ENUM__NONE "orientation-changed" True

-- | Emitted when toolbarSetStyle is called.
--
onStyleChanged, afterStyleChanged :: ToolbarClass tb => tb ->
                                     (ToolbarStyle -> IO ()) ->
                                     IO (ConnectId tb)
onStyleChanged = connect_ENUM__NONE "style-changed" False
afterStyleChanged = connect_ENUM__NONE "style-changed" True

-- | Emitted when the user right-clicks the toolbar or uses the keybinding to
-- display a popup menu.
--
-- * The handler should return True if the signal was handled, False if not.
--
onPopupContextMenu, afterPopupContextMenu :: ToolbarClass tb => tb ->
                                             (Int -> Int -> Int -> IO Bool) ->
                                             IO (ConnectId tb)
onPopupContextMenu = connect_INT_INT_INT__BOOL "popup-context-menu" False
afterPopupContextMenu = connect_INT_INT_INT__BOOL "popup-context-menu" True

--- NEW FILE: ToolItem.chs.pp ---
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ToolItem
--
--  Author : Duncan Coutts
--  Created: 1 August 2004
--
--  Copyright (c) 2004 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
-- |
--
-- ToolItem is the base class of widgets that can be added to "Toolbar".
--
-- ToolItems are widgets that can appear on a toolbar.
--
-- * For toolbar items that contain buttons, see the 'ToolButton',
-- 'ToggleToolButton' and 'RadioToolButton' widgets.
--
-- * To create a toolbar item that contain something else than a button, use
-- 'toolItemNew'. Use 'containerAdd' to add a child widget to the tool item.
--
-- See the "Toolbar" for a description of the toolbar widget.
--
-- * Added in GTK+ 2.4
--
module Graphics.UI.Gtk.MenuComboToolbar.ToolItem  (
#if GTK_CHECK_VERSION(2,4,0)
  toolItemNew,
  toolItemSetHomogeneous,
  toolItemGetHomogeneous,
  toolItemSetExpand,
  toolItemGetExpand,
  toolItemSetTooltip,
  toolItemSetUseDragWindow,
  toolItemGetUseDragWindow,
  toolItemSetVisibleHorizontal,
  toolItemGetVisibleHorizontal,
  toolItemSetVisibleVertical,
  toolItemGetVisibleVertical,
  toolItemSetIsImportant,
  toolItemGetIsImportant,
  IconSize,
  toolItemGetIconSize,
  Orientation(..),
  toolItemGetOrientation,
  ToolbarStyle(..),
  toolItemGetToolbarStyle,
  ReliefStyle(..),
  toolItemGetReliefStyle,
  toolItemRetrieveProxyMenuItem,
  toolItemGetProxyMenuItem,
  toolItemSetProxyMenuItem
#endif
  ) where

#if GTK_CHECK_VERSION(2,4,0)

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.Structs	(IconSize)
import Graphics.UI.Gtk.General.Enums	(Orientation(..), ToolbarStyle(..), ReliefStyle(..))

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

-- | Creates a new "ToolItem".
--
toolItemNew :: IO ToolItem
toolItemNew =
  makeNewObject mkToolItem {#call unsafe tool_item_new#}

-- | Sets whether the tool item is to be allocated the same size as other
-- homogeneous items. The effect is that all homogeneous items will have the
-- same width as the widest of the items.
--
toolItemSetHomogeneous :: ToolItemClass item => item -> Bool -> IO ()
toolItemSetHomogeneous item homogeneous =
  {#call tool_item_set_homogeneous#} (toToolItem item) (fromBool homogeneous)

-- | Returns whether the tool item is the same size as other homogeneous items.
--
toolItemGetHomogeneous :: ToolItemClass item => item -> IO Bool
toolItemGetHomogeneous item = liftM toBool $
  {#call unsafe tool_item_get_homogeneous#} (toToolItem item)

-- | Sets whether the tool item is allocated extra space when there is more room
-- on the toolbar then needed for the items. The effect is that the item gets
-- bigger when the toolbar gets bigger and smaller when the toolbar gets
-- smaller.
--
toolItemSetExpand :: ToolItemClass item => item -> Bool -> IO ()
toolItemSetExpand item expand = 
  {#call tool_item_set_expand#} (toToolItem item) (fromBool expand)

-- | Returns whether the tool item is allocated extra space.
--
toolItemGetExpand :: ToolItemClass item => item -> IO Bool
toolItemGetExpand item = liftM toBool $
  {#call unsafe tool_item_get_expand#} (toToolItem item)

-- | Sets the "Tooltips" object to be used for the tool item, the text to be
-- displayed as tooltip on the item and the private text to be used. See
-- 'tooltipsSetTip'.
--
toolItemSetTooltip :: ToolItemClass item => item -> Tooltips
                   -> String  -- ^ 
                   -> String  -- ^ 
                   -> IO ()
toolItemSetTooltip item tips text private =
  withUTFString text $ \strPtr1 ->
  withUTFString private $ \strPtr2 ->
  {#call tool_item_set_tooltip#} (toToolItem item) tips strPtr1 strPtr2

-- | Sets whether toolitem has a drag window. When True the tool item can be
-- used as a drag source through 'dragSourceSet'. When the tool item has a drag
-- window it will intercept all events, even those that would otherwise be sent
-- to a child widget.
--
toolItemSetUseDragWindow :: ToolItemClass item => item -> Bool -> IO ()
toolItemSetUseDragWindow item useDragWin = 
  {#call tool_item_set_use_drag_window#} (toToolItem item) (fromBool useDragWin)

-- | Returns whether the tool item has a drag window. See
-- 'toolItemSetUseDragWindow'.
--
toolItemGetUseDragWindow :: ToolItemClass item => item -> IO Bool
toolItemGetUseDragWindow item = liftM toBool $
  {#call unsafe tool_item_get_use_drag_window#} (toToolItem item)

-- | Sets whether the tool item is visible when the toolbar is docked
-- horizontally.
--
toolItemSetVisibleHorizontal :: ToolItemClass item => item -> Bool -> IO ()
toolItemSetVisibleHorizontal item visible = 
  {#call tool_item_set_visible_horizontal#} (toToolItem item) (fromBool visible)

-- | Returns whether the tool item is visible on toolbars that are docked
-- horizontally.
--
toolItemGetVisibleHorizontal :: ToolItemClass item => item -> IO Bool
toolItemGetVisibleHorizontal item = liftM toBool $
  {#call unsafe tool_item_get_visible_horizontal#} (toToolItem item)

-- | Sets whether the tool item is visible when the toolbar is docked
-- vertically. Some tool items, such as text entries, are too wide to be useful
-- on a vertically docked toolbar. If False the tool item will not appear on
-- toolbars that are docked vertically.
--
toolItemSetVisibleVertical :: ToolItemClass item => item -> Bool -> IO ()
toolItemSetVisibleVertical item visible = 
  {#call tool_item_set_visible_vertical#} (toToolItem item) (fromBool visible)

-- | Returns whether the tool item is visible when the toolbar is docked
-- vertically.
--
toolItemGetVisibleVertical :: ToolItemClass item => item -> IO Bool
toolItemGetVisibleVertical item = liftM toBool $
  {#call unsafe tool_item_get_visible_vertical#} (toToolItem item)

-- | Sets whether the tool item should be considered important. The "ToolButton"
-- class uses this property to determine whether to show or hide its label when
-- the toolbar style is 'ToolbarBothHoriz'. The result is that only tool buttons
-- with the \"is important\" property set have labels, an effect known as
-- \"priority text\".
--
toolItemSetIsImportant :: ToolItemClass item => item -> Bool -> IO ()
toolItemSetIsImportant item important = 
  {#call tool_item_set_is_important#} (toToolItem item) (fromBool important)

-- | Returns whether the tool item is considered important.
--
toolItemGetIsImportant :: ToolItemClass item => item -> IO Bool
toolItemGetIsImportant item = liftM toBool $
  {#call unsafe tool_item_get_is_important#} (toToolItem item)

-- | Returns the icon size used for the tool item.
--
toolItemGetIconSize :: ToolItemClass item => item -> IO IconSize
toolItemGetIconSize item = liftM (toEnum.fromIntegral) $
  {#call unsafe tool_item_get_icon_size#} (toToolItem item)

-- | Returns the orientation used for the tool item.
--
toolItemGetOrientation :: ToolItemClass item => item -> IO Orientation
toolItemGetOrientation item = liftM (toEnum.fromIntegral) $
  {#call unsafe tool_item_get_orientation#} (toToolItem item)

-- | Returns the toolbar style used for the tool item.
--
toolItemGetToolbarStyle :: ToolItemClass item => item -> IO ToolbarStyle
toolItemGetToolbarStyle item = liftM (toEnum.fromIntegral) $
  {#call unsafe tool_item_get_toolbar_style#} (toToolItem item)

-- | Returns the relief style of the tool item. See 'buttonSetReliefStyle'.
--
toolItemGetReliefStyle :: ToolItemClass item => item -> IO ReliefStyle
toolItemGetReliefStyle item = liftM (toEnum.fromIntegral) $
  {#call unsafe tool_item_get_relief_style#} (toToolItem item)

-- | Returns the "MenuItem" that was last set by 'toolItemSetProxyMenuItem',
-- ie. the "MenuItem" that is going to appear in the overflow menu.
--
toolItemRetrieveProxyMenuItem :: ToolItemClass item => item -> IO (Maybe Widget)
toolItemRetrieveProxyMenuItem item = do
  wPtr <- {#call unsafe tool_item_retrieve_proxy_menu_item#} (toToolItem item)
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

-- | If the menu item identifier string matches the string passed to
-- 'toolItemSetProxyMenuItem' the returns the corresponding "MenuItem".
--
toolItemGetProxyMenuItem :: ToolItemClass item => item -> String -> IO (Maybe Widget)
toolItemGetProxyMenuItem item itemId =
  withCString itemId $ \strPtr -> do
  wPtr <- {#call unsafe tool_item_get_proxy_menu_item#} (toToolItem item) strPtr
  if wPtr==nullPtr then return Nothing else liftM Just $
    makeNewObject mkWidget $ return wPtr

-- | Sets the "MenuItem" used in the toolbar overflow menu. The menu item identifier
-- is used to identify the caller of this function and should also be used with
-- 'toolItemGetProxyMenuItem'.
--
toolItemSetProxyMenuItem :: (ToolItemClass item, MenuItemClass menuItem) => item
                         -> String   -- ^ Menu item identifier string
                         -> menuItem -- ^ A "MenuItem" to be used in the
                                     -- overflow menu
                         -> IO ()
toolItemSetProxyMenuItem item menuItemId menuItem = 
  withCString menuItemId $ \strPtr ->
  {#call tool_item_set_proxy_menu_item#} (toToolItem item)
    strPtr (toWidget menuItem)

#endif

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Layout Layout.chs,NONE,1.1 Table.chs,NONE,1.1 VBox.chs,NONE,1.1 VButtonBox.chs,NONE,1.1 VPaned.chs,NONE,1.1

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

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

Added Files:
	Layout.chs Table.chs VBox.chs VButtonBox.chs VPaned.chs 
Log Message:
hierarchical namespace conversion


--- NEW FILE: VPaned.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget VPaned
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:39 $
--
--  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.
--
-- |
--

module Graphics.UI.Gtk.Layout.VPaned (
  VPaned,
  VPanedClass,
  castToVPaned,
  vPanedNew
  ) where

import Monad	(liftM)

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

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

-- methods

-- | 
--
vPanedNew :: IO VPaned
vPanedNew = makeNewObject mkVPaned $ liftM castPtr {#call unsafe vpaned_new#}

--- NEW FILE: Layout.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Layout
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:39 $
--
--  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 layout widget can hold several widgets at arbitrary positions.
--

module Graphics.UI.Gtk.Layout.Layout (
  Layout,
  LayoutClass,
  castToLayout,
  layoutNew,
  layoutPut,
  layoutMove,
  layoutSetSize,
  layoutGetSize,
  layoutGetHAdjustment,
  layoutGetVAdjustment,
  layoutSetHAdjustment,
  layoutSetVAdjustment,
  onSetScrollAdjustments,
  afterSetScrollAdjustments
  ) where

import Maybe	(fromMaybe)
import Monad	(liftM)

import System.Glib.FFI
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 layout widget.
--
layoutNew :: Maybe Adjustment -> Maybe Adjustment -> IO Layout
layoutNew vAdj hAdj = makeNewObject mkLayout $ liftM castPtr $
  {#call unsafe layout_new#} (fromMAdj hAdj) (fromMAdj vAdj)
 where
 fromMAdj :: Maybe Adjustment -> Adjustment
 fromMAdj = fromMaybe $ mkAdjustment nullForeignPtr


-- | Insert a widget into the layout container.
--
layoutPut :: (LayoutClass l, WidgetClass w) => l -> w -> Int -> Int -> IO ()
layoutPut l widget x y = {#call layout_put#} (toLayout l) (toWidget widget)
  (fromIntegral x) (fromIntegral y)

-- | Move an existing widget within the container.
--
layoutMove :: (LayoutClass l, WidgetClass w) => l -> w -> Int -> Int -> IO ()
layoutMove l widget x y = {#call layout_move#} (toLayout l) (toWidget widget)
  (fromIntegral x) (fromIntegral y)

-- | Set the size of the layout widget.
--
layoutSetSize :: LayoutClass l => l -> Int -> Int -> IO ()
layoutSetSize l width height = {#call layout_set_size#} (toLayout l)
  (fromIntegral width) (fromIntegral height)

-- | Get the size of the layout widget.
--
layoutGetSize :: LayoutClass l => l -> IO (Int, Int)
layoutGetSize l =
  alloca $ \widthPtr -> alloca $ \heightPtr -> do
  {#call unsafe layout_get_size#} (toLayout l) widthPtr heightPtr
  width <-peek widthPtr
  height <- peek heightPtr
  return (fromIntegral width, fromIntegral height)

-- | Retrieve the horizontal 'Adjustment' object from the layout.
--
layoutGetHAdjustment :: LayoutClass l => l -> IO Adjustment
layoutGetHAdjustment l = makeNewObject mkAdjustment $
  {#call unsafe layout_get_hadjustment#} (toLayout l)

-- | Retrieve the vertical 'Adjustment' object from the layout.
--
layoutGetVAdjustment :: LayoutClass l => l -> IO Adjustment
layoutGetVAdjustment l = makeNewObject mkAdjustment $
  {#call unsafe layout_get_vadjustment#} (toLayout l)

-- | Set the horizontal adjustment object.
--
layoutSetHAdjustment :: LayoutClass l => l -> Adjustment -> IO ()
layoutSetHAdjustment l adj = {#call layout_set_hadjustment#} (toLayout l) adj

-- | Set the vertical adjustment object.
--
layoutSetVAdjustment :: LayoutClass l => l -> Adjustment -> IO ()
layoutSetVAdjustment l adj = {#call layout_set_vadjustment#} (toLayout l) adj

-- signals

-- | In case the adjustments are
-- replaced, this signal is emitted.
--
onSetScrollAdjustments, afterSetScrollAdjustments :: LayoutClass l => l ->(Adjustment -> Adjustment -> IO ()) ->
                                                     IO (ConnectId l)
onSetScrollAdjustments = 
  connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" False
afterSetScrollAdjustments = 
  connect_OBJECT_OBJECT__NONE "set-scroll-adjustments" True


--- NEW FILE: VBox.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget VBox
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:39 $
--
--  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 is a special version of 'Box'. 
-- This widget shows its child widgets
-- in a vertical line.
--

module Graphics.UI.Gtk.Layout.VBox (
  VBox,
  VBoxClass,
  castToVBox,
  vBoxNew
  ) where

import Monad	(liftM)

import System.Glib.FFI
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 container that shows several children vertically. 
--
-- * If @homogeneous@
-- is set all children will be allotted the same amount of space. There will be
-- @spacing@ pixel between each two children.
--
vBoxNew :: Bool -> Int -> IO VBox
vBoxNew homogeneous spacing = makeNewObject mkVBox $ liftM castPtr $
  {#call unsafe vbox_new#} (fromBool homogeneous) (fromIntegral spacing)




--- NEW FILE: VButtonBox.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget VButtonBox
--
--  Author : Matthew Walton
--          
--  Created: 28 April 2004
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:39 $
--
--  Copyright (c) 2004 Matthew Walton
--
--  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.
--
-- |
--

module Graphics.UI.Gtk.Layout.VButtonBox  (
  VButtonBox,
  VButtonBoxClass,
  castToVButtonBox,
  vButtonBoxNew
  ) where

import Monad (liftM)

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

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

--methods

-- | 
--
vButtonBoxNew :: IO VButtonBox
vButtonBoxNew = makeNewObject mkVButtonBox $
  liftM castPtr {#call unsafe vbutton_box_new#}


--- NEW FILE: Table.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Table
--
--  Author : Axel Simon
--          
--  Created: 15 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:23:39 $
--
--  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 table widget is a container in which widgets can be aligned in cells.
--

module Graphics.UI.Gtk.Layout.Table (
  Table,
  TableClass,
  castToTable,
  tableNew,
  tableResize,
  AttachOptions(..),
  tableAttach,
  tableAttachDefaults,
  tableSetRowSpacing,
  tableGetRowSpacing,
  tableSetColSpacing,
  tableGetColSpacing,
  tableSetRowSpacings,
  tableGetDefaultRowSpacing,
  tableSetColSpacings,
  tableGetDefaultColSpacing,
  tableSetHomogeneous,
  tableGetHomogeneous
  ) where

import Monad	(liftM)

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

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

-- methods

-- | Create a new table with the specified dimensions.
-- Set @homogeneous@ to True if all cells should be of the same size.
--
tableNew :: Int -> Int -> Bool -> IO Table
tableNew rows columns homogeneous = makeNewObject mkTable $ liftM castPtr $
  {#call unsafe table_new#} (fromIntegral rows) (fromIntegral columns)
  (fromBool homogeneous)

-- | Change the dimensions of an already existing table.
--
tableResize :: TableClass tb => tb -> Int -> Int -> IO ()
tableResize tb rows columns = {#call table_resize#} (toTable tb)
  (fromIntegral rows) (fromIntegral columns)

-- | Put a new widget in the table container. The widget should span the cells
-- (leftAttach,topAttach) to (rightAttach,bottomAttach). Further formatting
-- options have to be specified.
--
tableAttach :: (TableClass tb, WidgetClass w) => tb -> w -> Int -> Int ->
               Int -> Int -> [AttachOptions] -> [AttachOptions] -> Int ->
               Int -> IO ()
tableAttach tb child leftAttach rightAttach topAttach bottomAttach xoptions
            yoptions xpadding ypadding = {#call table_attach#} (toTable tb)
  (toWidget child) (fromIntegral leftAttach) (fromIntegral rightAttach) 
  (fromIntegral topAttach) (fromIntegral bottomAttach) 
  ((fromIntegral.fromFlags) xoptions) ((fromIntegral.fromFlags) yoptions) 
  (fromIntegral xpadding) (fromIntegral ypadding)

-- | Put a new widget in the table container. As opposed to 'tableAttach' this
-- function assumes default values for the packing options.
--
tableAttachDefaults :: (TableClass tb, WidgetClass w) => tb -> w -> Int ->
                       Int -> Int -> Int -> IO ()
tableAttachDefaults tb child leftAttach rightAttach topAttach bottomAttach =
  {#call table_attach_defaults#} (toTable tb) (toWidget child) 
  (fromIntegral leftAttach) (fromIntegral rightAttach) 
  (fromIntegral topAttach) (fromIntegral bottomAttach)

-- | Set the amount of space (in pixels) between the specified row and its
-- neighbours.
--
tableSetRowSpacing :: TableClass tb => tb
                   -> Int  -- ^ Row number, indexed from 0
                   -> Int  -- ^ Spacing size in pixels
                   -> IO ()
tableSetRowSpacing tb row space = {#call table_set_row_spacing#}
  (toTable tb) (fromIntegral row) (fromIntegral space)

-- | Get the amount of space (in pixels) between the specified row and the
-- next row.
--
tableGetRowSpacing :: TableClass tb => tb -> Int -> IO Int
tableGetRowSpacing tb row = liftM fromIntegral $
  {#call unsafe table_get_row_spacing#} (toTable tb) (fromIntegral row)

-- | Set the amount of space (in pixels) between the specified column and
-- its neighbours.
--
tableSetColSpacing :: TableClass tb => tb -> Int -> Int -> IO ()
tableSetColSpacing tb col space = {#call table_set_col_spacing#}
  (toTable tb) (fromIntegral col) (fromIntegral space)

-- | Get the amount of space (in pixels) between the specified column and the
-- next column.
--
tableGetColSpacing :: TableClass tb => tb -> Int -> IO Int
tableGetColSpacing tb col = liftM fromIntegral $
  {#call unsafe table_get_col_spacing#} (toTable tb) (fromIntegral col)

-- | Set the amount of space between any two rows.
--
tableSetRowSpacings :: TableClass tb => tb -> Int -> IO ()
tableSetRowSpacings tb space = {#call table_set_row_spacings#}
  (toTable tb) (fromIntegral space)

-- | Gets the default row spacing for the table. This is the spacing that will
-- be used for newly added rows.
--
tableGetDefaultRowSpacing :: TableClass tb => tb -> IO Int
tableGetDefaultRowSpacing tb = liftM fromIntegral $
  {#call unsafe table_get_default_row_spacing#} (toTable tb)

-- | Set the amount of space between any two columns.
--
tableSetColSpacings :: TableClass tb => tb -> Int -> IO ()
tableSetColSpacings tb space = {#call table_set_col_spacings#}
  (toTable tb) (fromIntegral space)

-- | Gets the default column spacing for the table. This is the spacing that
-- will be used for newly added columns.
--
tableGetDefaultColSpacing :: TableClass tb => tb -> IO Int
tableGetDefaultColSpacing tb = liftM fromIntegral $
  {#call unsafe table_get_default_col_spacing#} (toTable tb)

-- | Make all cells the same size.
--
tableSetHomogeneous :: TableClass tb => tb -> Bool -> IO ()
tableSetHomogeneous tb hom = 
  {#call table_set_homogeneous#} (toTable tb) (fromBool hom)

-- | Returns whether the table cells are all constrained to the same width and
-- height.
--
tableGetHomogeneous :: TableClass tb => tb -> IO Bool
tableGetHomogeneous tb =
  liftM toBool $ {#call unsafe table_get_homogeneous#} (toTable tb)