Don't export valueUnset since it's not used outside of the module

-- -*-haskell-*-
--  GIMP Toolkit (GTK) GValue
--
--  Author : Axel Simon
--
--  Created: 1 June 2001
--
--  Version $Revision: 1.3 $ from $Date: 2005/11/16 13:14:16 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- This module implements only the necessities for the GTK binding.
--
-- * Everything here is only used by "Graphics.UI.Gtk.TreeList.TreeModel" and
-- friends.
--
module System.Glib.GValue (
  GValue(GValue),
  valueInit,
  valueGetType,
  allocaGValue
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GType	(GType)

{# context lib="glib" prefix="g" #}

{# pointer *GValue newtype #}

-- | Clear a GValue.
--
valueInit :: GValue -> GType -> IO ()
valueInit gv gt = do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# call unsafe value_init #} gv gt
  return ()

-- | Get the type of the value stored in the GValue
--
valueGetType :: GValue -> IO GType
valueGetType (GValue gvPtr) = {# get GValue->g_type #} gvPtr

-- | Temporarily allocate a GValue.
--
allocaGValue :: (GValue -> IO b) -> IO b
allocaGValue body =
  -- c2hs is broken in that it can't handle arrays of compound arrays in the
  -- sizeof hook
  allocaBytes ({# sizeof GType #}+ 2* {# sizeof guint64 #}) $ \gvPtr -> do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# set GValue->g_type #} gvPtr (0 :: GType)
  result <- body (GValue gvPtr)
  {#call unsafe value_unset#} (GValue gvPtr)
  return result

-- -*-haskell-*-
--  GIMP Toolkit (GTK) GValue
--
--  Author : Axel Simon
--
--  Created: 1 June 2001
--
--  Version $Revision: 1.3 $ from $Date: 2005/11/16 13:14:16 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- This module implements only the necessities for the GTK binding.
--
-- * Everything here is only used by "Graphics.UI.Gtk.TreeList.TreeModel" and
-- friends.
--
module System.Glib.GValue (
  GValue(GValue),
  valueInit,
  valueUnset,
  valueGetType,
  allocaGValue
  ) where

import Monad	(liftM)

import System.Glib.FFI
import System.Glib.GType	(GType)

{# context lib="glib" prefix="g" #}

{# pointer *GValue newtype #}

-- | Clear a GValue.
--
valueInit :: GValue -> GType -> IO ()
valueInit gv gt = do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# call unsafe value_init #} gv gt
  return ()

-- | Free the data in a GValue.
--
valueUnset :: GValue -> IO ()
valueUnset = {#call unsafe value_unset#}

-- | Get the type of the value stored in the GValue
--
valueGetType :: GValue -> IO GType
valueGetType (GValue gvPtr) = {# get GValue->g_type #} gvPtr

-- | Temporarily allocate a GValue.
--
allocaGValue :: (GValue -> IO b) -> IO b
allocaGValue body =
  -- c2hs is broken in that it can't handle arrays of compound arrays in the
  -- sizeof hook
  allocaBytes ({# sizeof GType #}+ 2* {# sizeof guint64 #}) $ \gvPtr -> do
  -- The g_type field of the value must be zero or g_value_init will fail.
  {# set GValue->g_type #} gvPtr (0 :: GType)
  result <- body (GValue gvPtr)
  valueUnset (GValue gvPtr)
  return result


[project @ 2003-01-18 17:44:07 by as49]

[project @ 2003-01-18 17:44:07 by as49]

Move Plug.chs to ../embedding. It makes more sense and makes building on
Windows easier.

darcs-hash:20030118174407-d90cf-b42a502af30d333171ad80bbd941e958ac6c0920.gz

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry Widget Plug@
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.3 $ from $Date: 2002/08/05 16:41:35 $
--
--  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.
--
-- @description@ --------------------------------------------------------------
--
-- * Plug is a window that is to be attached to the window of another
--   application. If you have managed to receive the @ref type XID@ from
--   the inviting application you can construct the Plug and add your widgets
--   to it.
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------

module Plug(
  Plug,
  PlugClass,
  castToPlug,
  XID,
  plugNew
  ) where

import Monad	(liftM)
import Foreign
import UTFCForeign
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Structs	(XID)

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

-- methods

plugNew :: XID -> IO Plug
plugNew nw = makeNewObject mkPlug $ liftM castPtr $
  {#call unsafe plug_new#} nw


[project @ 2002-07-17 16:09:05 by juhp] Bind entryGetText.

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry Widget Entry@
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.4 $ from $Date: 2002/07/17 16:09:05 $
--
--  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.
--
-- @description@ --------------------------------------------------------------
--
-- * This widget lets the user enter a single line of text.
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------
--
-- * A couple of signals are not bound because I could not figure out what
--   they mean. Some of them do not seem to be emitted at all.
--
module Entry(
  Entry,
  EntryClass,
  castToEntry,
  entrySelectRegion,
  entryGetSelectionBounds,
  entryInsertText,
  entryDeleteText,
  entryGetChars,
  entryCutClipboard,
  entryCopyClipboard,
  entryPasteClipboard,
  entryDeleteSelection,
  entrySetEditable,
  entryNew,
  entrySetText,
  entryGetText,
  entryAppendText,
  entryPrependText,
  entrySetVisibility,
  entrySetInvisibleChar,
  entrySetMaxLength,
  entryGetActivatesDefault,
  entrySetActivatesDefault,
  entryGetHasFrame,
  entrySetHasFrame,
  entryGetWidthChars,
  entrySetWidthChars,
  onEntryActivate,
  afterEntryActivate,
  onEntryChanged,
  afterEntryChanged,
  onCopyClipboard,
  afterCopyClipboard,
  onCutClipboard,
  afterCutClipboard,
  onPasteClipboard,
  afterPasteClipboard,
  onDeleteText,
  afterDeleteText,
  onInsertAtCursor,
  afterInsertAtCursor,
  onToggleOverwrite,
  afterToggleOverwrite
  ) where

import Monad	(liftM)
import Foreign
import UTFCForeign
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Char	(ord)

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

-- methods originating in the Editable base class which is not really a base
-- class of in the Gtk Hierarchy (it is non-existant). I renamed
{#pointer *Editable foreign#}

toEditable :: EntryClass ed => ed -> Editable
toEditable = castForeignPtr.unEntry.toEntry

-- @method entrySelectRegion@ Select a span of text.
--
-- * A negative @ref arg end@ position will make the selection extend to the
--   end of the buffer.
--
-- * Calling this function with @ref arg start@=1 and @ref arg end@=4 it will
--   mark "ask" in the string "Haskell". (FIXME: verify)
--
entrySelectRegion :: EntryClass ed => ed -> Int -> Int -> IO ()
entrySelectRegion ed start end = {#call editable_select_region#}
  (toEditable ed) (fromIntegral start) (fromIntegral end)

-- @method entryGetSelectionBounds@ Get the span of the current selection.
--
-- * The returned tuple is not ordered. The second index represents the
--   position of the cursor. The first index is the other end of the
--   selection. If both numbers are equal there is in fact no selection.
--
entryGetSelectionBounds :: EntryClass ed => ed -> IO (Int,Int)
entryGetSelectionBounds ed = alloca $ \startPtr -> alloca $ \endPtr -> do
  {#call unsafe editable_get_selection_bounds#} (toEditable ed) startPtr endPtr
  start <- liftM fromIntegral $ peek startPtr
  end	<- liftM fromIntegral $ peek endPtr
  return (start,end)

-- @method entryInsertText@ Insert new text at the specified position.
--
-- * If the position is invalid the text will be inserted at the end of the
--   buffer. The returned value reflects the actual insertion point.
--
entryInsertText :: EntryClass ed => ed -> String -> Int -> IO Int
entryInsertText ed str pos = withObject (fromIntegral pos) $ \posPtr ->
  withCStringLen str $ \(strPtr,len) -> do
    {#call editable_insert_text#} (toEditable ed) strPtr (fromIntegral len)
      posPtr
    liftM fromIntegral $ peek posPtr

-- @method entryDeleteText@ Delete a given range of text.
--
-- * If the @ref arg end@ position is invalid, it is set to the lenght of the
--   buffer.
--
-- * @ref arg start@ is restricted to 0..@end.
--
entryDeleteText :: EntryClass ed => ed -> Int -> Int -> IO ()
entryDeleteText ed start end = {#call editable_delete_text#} (toEditable ed)
  (fromIntegral start) (fromIntegral end)

-- @method entryGetChars@ Retrieve a range of characters.
--
-- * Set @ref arg end@ to a negative value to reach the end of the buffer.
--
entryGetChars :: EntryClass ed => ed -> Int -> Int -> IO String
entryGetChars ed start end = do
  strPtr <- {#call unsafe editable_get_chars#} (toEditable ed)
    (fromIntegral start) (fromIntegral end)
  str <- peekCString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str

-- @method entryCutClipboard@ Cut the selected characters to the Clipboard.
--
entryCutClipboard :: EntryClass ed => ed -> IO ()
entryCutClipboard  = {#call editable_cut_clipboard#}.toEditable

-- @method entryCopyClipboard@ Copy the selected characters to the Clipboard.
--
entryCopyClipboard :: EntryClass ed => ed -> IO ()
entryCopyClipboard  = {#call editable_copy_clipboard#}.toEditable

-- @method entryPasteClipboard@ Paste the selected characters to the
-- Clipboard.
--
entryPasteClipboard :: EntryClass ed => ed -> IO ()
entryPasteClipboard  = {#call editable_paste_clipboard#}.toEditable

-- @method entryDeleteSelection@ Delete the current selection.
--
entryDeleteSelection :: EntryClass ed => ed -> IO ()
entryDeleteSelection  = {#call editable_delete_selection#}.toEditable

-- @method entrySetPosition@ Set the cursor to a specific position.
--
entrySetPosition :: EntryClass ed => ed -> Int -> IO ()
entrySetPosition ed pos =
  {#call editable_set_position#} (toEditable ed) (fromIntegral pos)

-- @method entryGetPosition@ Get the current cursor position.
--
entryGetPosition :: EntryClass ed => ed -> IO Int
entryGetPosition ed = liftM fromIntegral $
  {#call unsafe editable_get_position#} (toEditable ed)

-- @method entrySetEditable@ Make an @ref type Entry@ insensitive.
--
-- * Called with False will make the text uneditable.
--
entrySetEditable :: EntryClass ed => ed -> Bool -> IO ()
entrySetEditable ed isEditable = {#call editable_set_editable#}
  (toEditable ed) (fromBool isEditable)

-- methods

-- @constructor entryNew@ Create a new @ref type Entry@ widget.
--
entryNew :: IO Entry
entryNew  = makeNewObject mkEntry $ liftM castPtr $ {#call unsafe entry_new#}

-- @method entrySetText@ Set the text of the @ref type Entry@ widget.
--
entrySetText :: EntryClass ec => ec -> String -> IO ()
entrySetText ec str = withCString str $ {#call entry_set_text#} (toEntry ec)

-- @method entryGetText@ Get the text of the @ref type Entry@ widget.
--
entryGetText :: EntryClass ec => ec -> IO String
entryGetText ec = {#call entry_get_text#} (toEntry ec) >>= peekCString

-- @method entryAppendText@ Append to the text of the @ref type Entry@ widget.
--
entryAppendText :: EntryClass ec => ec -> String -> IO ()
entryAppendText ec str =
  withCString str $ {#call entry_append_text#} (toEntry ec)

-- @method entryPrependText@ Prepend the text of the @ref type Entry@ widget.
--
entryPrependText :: EntryClass ec => ec -> String -> IO ()
entryPrependText ec str =
  withCString str $ {#call entry_prepend_text#} (toEntry ec)

-- @method entrySetVisibility@ Set whether to use password mode (display stars
-- instead of the text).
--
-- * The replacement character can be changed with
--   @ref method entrySetInvisibleChar@.
--
entrySetVisibility :: EntryClass ec => ec -> Bool -> IO ()
entrySetVisibility ec visible =
  {#call entry_set_visibility#} (toEntry ec) (fromBool visible)

-- @method entrySetInvisibleChar@ Set the replacement character for invisible
-- text.
--
entrySetInvisibleChar :: EntryClass ec => ec -> Char -> IO ()
entrySetInvisibleChar ec ch =
  {#call unsafe entry_set_invisible_char#} (toEntry ec) ((fromIntegral.ord) ch)

-- @method entrySetMaxLength@ Sets a maximum length the text may grow to.
--
-- * A negative number resets the restriction.
--
entrySetMaxLength :: EntryClass ec => ec -> Int -> IO ()
entrySetMaxLength ec max =
  {#call entry_set_max_length#} (toEntry ec) (fromIntegral max)

-- @method entryGetActivatesDefault@ Query whether pressing return will
-- activate the default widget.
--
entryGetActivatesDefault :: EntryClass ec => ec -> IO Bool
entryGetActivatesDefault ec = liftM toBool $
  {#call unsafe entry_get_activates_default#} (toEntry ec)

-- @method entrySetActivatesDefault@ Specify if pressing return will activate
-- the default widget.
--
-- * This setting is useful in @ref arg Dialog@ boxes where enter should press
--   the default button.
--
entrySetActivatesDefault :: EntryClass ec => ec -> Bool -> IO ()
entrySetActivatesDefault ec setting = {#call entry_set_activates_default#}
  (toEntry ec) (fromBool setting)

-- @method entryGetHasFrame@ Query if the text @ref type Entry@ is displayed
-- with a frame around it.
--
entryGetHasFrame :: EntryClass ec => ec -> IO Bool
entryGetHasFrame ec = liftM toBool $
  {#call unsafe entry_get_has_frame#} (toEntry ec)

-- @method entrySetHasFrame@ Specifies whehter the @ref type Entry@ should be
-- in an etched-in frame.
--
entrySetHasFrame :: EntryClass ec => ec -> Bool -> IO ()
entrySetHasFrame ec setting = {#call entry_set_has_frame#}
  (toEntry ec) (fromBool setting)

-- @method entryGetWidthChars@ Retrieve the number of characters the widget
-- should ask for.
--
entryGetWidthChars :: EntryClass ec => ec -> IO Int
entryGetWidthChars ec = liftM fromIntegral $
  {#call unsafe entry_get_width_chars#} (toEntry ec)

-- @method entrySetWidthChars@ Specifies how large the @ref type Entry@ should
-- be in characters.
--
-- * This setting is only considered when the widget formulates its size
--   request. Make sure that it is not mapped (shown) before you change this
--   value.
--
entrySetWidthChars :: EntryClass ec => ec -> Int -> IO ()
entrySetWidthChars ec setting = {#call entry_set_width_chars#}
  (toEntry ec) (fromIntegral setting)

-- signals

-- @signal connectToEntryActivate@ Emitted when the user presses return within
-- the @ref arg Entry@ field.
--
onEntryActivate, afterEntryActivate :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onEntryActivate = connect_NONE__NONE "activate" False
afterEntryActivate = connect_NONE__NONE "activate" True

-- @signal connectToEntryChanged@ Emitted when the settings of the
-- @ref arg Entry@ widget changes.
--
onEntryChanged, afterEntryChanged :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEntryChanged = connect_NONE__NONE "changed" False
afterEntryChanged = connect_NONE__NONE "changed" True

-- @signal connectToCopyClipboard@ Emitted when the current selection has been
-- copied to the clipboard.
--
onCopyClipboard, afterCopyClipboard :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onCopyClipboard = connect_NONE__NONE "copy_clipboard" False
afterCopyClipboard = connect_NONE__NONE "copy_clipboard" True

-- @signal connectToCutClipboard@ Emitted when the current selection has been
-- cut to the clipboard.
--
onCutClipboard, afterCutClipboard :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onCutClipboard = connect_NONE__NONE "cut_clipboard" False
afterCutClipboard = connect_NONE__NONE "cut_clipboard" True

-- @signal connectToPasteClipboard@ Emitted when the current selection has
-- been pasted from the clipboard.
--
onPasteClipboard, afterPasteClipboard :: EntryClass ec => ec -> IO () ->
                                         IO (ConnectId ec)
onPasteClipboard = connect_NONE__NONE "paste_clipboard" False
afterPasteClipboard = connect_NONE__NONE "paste_clipboard" True

-- @signal connectToDeleteText@ Emitted when a piece of text is deleted from
-- the @ref arg Entry@.
--
onDeleteText, afterDeleteText :: EntryClass ec => ec ->
                                 (Int -> Int -> IO ()) -> IO (ConnectId ec)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True

-- @signal connectToInsertAtCursor@ Emitted when a piece of text is inserted
-- at the cursor position.
--
onInsertAtCursor, afterInsertAtCursor :: EntryClass ec => ec ->
                                         (String -> IO ()) ->
                                         IO (ConnectId ec)
onInsertAtCursor = connect_STRING__NONE "insert_at_cursor" False
afterInsertAtCursor = connect_STRING__NONE "insert_at_cursor" True

-- @signal connectToToggleOverwrite@ Emitted when the user changes from
-- overwriting to inserting.
--
onToggleOverwrite, afterToggleOverwrite :: EntryClass ec => ec -> IO () ->
                                           IO (ConnectId ec)
onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False
afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True

-- -*-haskell-*-
--  GIMP Toolkit (GTK) @entry Widget Entry@
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.3 $ from $Date: 2002/05/24 09:43:24 $
--
--  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.
--
-- @description@ --------------------------------------------------------------
--
-- * This widget lets the user enter a single line of text.
--
-- @documentation@ ------------------------------------------------------------
--
--
-- @todo@ ---------------------------------------------------------------------
--
-- * A couple of signals are not bound because I could not figure out what
--   they mean. Some of them do not seem to be emitted at all.
--
module Entry(
  Entry,
  EntryClass,
  castToEntry,
  entrySelectRegion,
  entryGetSelectionBounds,
  entryInsertText,
  entryDeleteText,
  entryGetChars,
  entryCutClipboard,
  entryCopyClipboard,
  entryPasteClipboard,
  entryDeleteSelection,
  entrySetEditable,
  entryNew,
  entrySetText,
  entryAppendText,
  entryPrependText,
  entrySetVisibility,
  entrySetInvisibleChar,
  entrySetMaxLength,
  entryGetActivatesDefault,
  entrySetActivatesDefault,
  entryGetHasFrame,
  entrySetHasFrame,
  entryGetWidthChars,
  entrySetWidthChars,
  onEntryActivate,
  afterEntryActivate,
  onEntryChanged,
  afterEntryChanged,
  onCopyClipboard,
  afterCopyClipboard,
  onCutClipboard,
  afterCutClipboard,
  onPasteClipboard,
  afterPasteClipboard,
  onDeleteText,
  afterDeleteText,
  onInsertAtCursor,
  afterInsertAtCursor,
  onToggleOverwrite,
  afterToggleOverwrite
  ) where

import Monad	(liftM)
import Foreign
import UTFCForeign
import Object	(makeNewObject)
{#import Hierarchy#}
{#import Signal#}
import Char	(ord)

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

-- methods originating in the Editable base class which is not really a base
-- class of in the Gtk Hierarchy (it is non-existant). I renamed
{#pointer *Editable foreign#}

toEditable :: EntryClass ed => ed -> Editable
toEditable = castForeignPtr.unEntry.toEntry

-- @method entrySelectRegion@ Select a span of text.
--
-- * A negative @ref arg end@ position will make the selection extend to the
--   end of the buffer.
--
-- * Calling this function with @ref arg start@=1 and @ref arg end@=4 it will
--   mark "ask" in the string "Haskell". (FIXME: verify)
--
entrySelectRegion :: EntryClass ed => ed -> Int -> Int -> IO ()
entrySelectRegion ed start end = {#call editable_select_region#}
  (toEditable ed) (fromIntegral start) (fromIntegral end)

-- @method entryGetSelectionBounds@ Get the span of the current selection.
--
-- * The returned tuple is not ordered. The second index represents the
--   position of the cursor. The first index is the other end of the
--   selection. If both numbers are equal there is in fact no selection.
--
entryGetSelectionBounds :: EntryClass ed => ed -> IO (Int,Int)
entryGetSelectionBounds ed = alloca $ \startPtr -> alloca $ \endPtr -> do
  {#call unsafe editable_get_selection_bounds#} (toEditable ed) startPtr endPtr
  start <- liftM fromIntegral $ peek startPtr
  end	<- liftM fromIntegral $ peek endPtr
  return (start,end)

-- @method entryInsertText@ Insert new text at the specified position.
--
-- * If the position is invalid the text will be inserted at the end of the
--   buffer. The returned value reflects the actual insertion point.
--
entryInsertText :: EntryClass ed => ed -> String -> Int -> IO Int
entryInsertText ed str pos = withObject (fromIntegral pos) $ \posPtr ->
  withCStringLen str $ \(strPtr,len) -> do
    {#call editable_insert_text#} (toEditable ed) strPtr (fromIntegral len)
      posPtr
    liftM fromIntegral $ peek posPtr

-- @method entryDeleteText@ Delete a given range of text.
--
-- * If the @ref arg end@ position is invalid, it is set to the lenght of the
--   buffer.
--
-- * @ref arg start@ is restricted to 0..@end.
--
entryDeleteText :: EntryClass ed => ed -> Int -> Int -> IO ()
entryDeleteText ed start end = {#call editable_delete_text#} (toEditable ed)
  (fromIntegral start) (fromIntegral end)

-- @method entryGetChars@ Retrieve a range of characters.
--
-- * Set @ref arg end@ to a negative value to reach the end of the buffer.
--
entryGetChars :: EntryClass ed => ed -> Int -> Int -> IO String
entryGetChars ed start end = do
  strPtr <- {#call unsafe editable_get_chars#} (toEditable ed)
    (fromIntegral start) (fromIntegral end)
  str <- peekCString strPtr
  {#call unsafe g_free#} (castPtr strPtr)
  return str

-- @method entryCutClipboard@ Cut the selected characters to the Clipboard.
--
entryCutClipboard :: EntryClass ed => ed -> IO ()
entryCutClipboard  = {#call editable_cut_clipboard#}.toEditable

-- @method entryCopyClipboard@ Copy the selected characters to the Clipboard.
--
entryCopyClipboard :: EntryClass ed => ed -> IO ()
entryCopyClipboard  = {#call editable_copy_clipboard#}.toEditable

-- @method entryPasteClipboard@ Paste the selected characters to the
-- Clipboard.
--
entryPasteClipboard :: EntryClass ed => ed -> IO ()
entryPasteClipboard  = {#call editable_paste_clipboard#}.toEditable

-- @method entryDeleteSelection@ Delete the current selection.
--
entryDeleteSelection :: EntryClass ed => ed -> IO ()
entryDeleteSelection  = {#call editable_delete_selection#}.toEditable

-- @method entrySetPosition@ Set the cursor to a specific position.
--
entrySetPosition :: EntryClass ed => ed -> Int -> IO ()
entrySetPosition ed pos =
  {#call editable_set_position#} (toEditable ed) (fromIntegral pos)

-- @method entryGetPosition@ Get the current cursor position.
--
entryGetPosition :: EntryClass ed => ed -> IO Int
entryGetPosition ed = liftM fromIntegral $
  {#call unsafe editable_get_position#} (toEditable ed)

-- @method entrySetEditable@ Make an @ref type Entry@ insensitive.
--
-- * Called with False will make the text uneditable.
--
entrySetEditable :: EntryClass ed => ed -> Bool -> IO ()
entrySetEditable ed isEditable = {#call editable_set_editable#}
  (toEditable ed) (fromBool isEditable)

-- methods

-- @constructor entryNew@ Create a new @ref type Entry@ widget.
--
entryNew :: IO Entry
entryNew  = makeNewObject mkEntry $ liftM castPtr $ {#call unsafe entry_new#}

-- @method entrySetText@ Set the text of the @ref type Entry@ widget.
--
entrySetText :: EntryClass ec => ec -> String -> IO ()
entrySetText ec str = withCString str $ {#call entry_set_text#} (toEntry ec)

-- @method entryAppendText@ Append to the text of the @ref type Entry@ widget.
--
entryAppendText :: EntryClass ec => ec -> String -> IO ()
entryAppendText ec str =
  withCString str $ {#call entry_append_text#} (toEntry ec)

-- @method entryPrependText@ Prepend the text of the @ref type Entry@ widget.
--
entryPrependText :: EntryClass ec => ec -> String -> IO ()
entryPrependText ec str =
  withCString str $ {#call entry_prepend_text#} (toEntry ec)

-- @method entrySetVisibility@ Set whether to use password mode (display stars
-- instead of the text).
--
-- * The replacement character can be changed with
--   @ref method entrySetInvisibleChar@.
--
entrySetVisibility :: EntryClass ec => ec -> Bool -> IO ()
entrySetVisibility ec visible =
  {#call entry_set_visibility#} (toEntry ec) (fromBool visible)

-- @method entrySetInvisibleChar@ Set the replacement character for invisible
-- text.
--
entrySetInvisibleChar :: EntryClass ec => ec -> Char -> IO ()
entrySetInvisibleChar ec ch =
  {#call unsafe entry_set_invisible_char#} (toEntry ec) ((fromIntegral.ord) ch)

-- @method entrySetMaxLength@ Sets a maximum length the text may grow to.
--
-- * A negative number resets the restriction.
--
entrySetMaxLength :: EntryClass ec => ec -> Int -> IO ()
entrySetMaxLength ec max =
  {#call entry_set_max_length#} (toEntry ec) (fromIntegral max)

-- @method entryGetActivatesDefault@ Query whether pressing return will
-- activate the default widget.
--
entryGetActivatesDefault :: EntryClass ec => ec -> IO Bool
entryGetActivatesDefault ec = liftM toBool $
  {#call unsafe entry_get_activates_default#} (toEntry ec)

-- @method entrySetActivatesDefault@ Specify if pressing return will activate
-- the default widget.
--
-- * This setting is useful in @ref arg Dialog@ boxes where enter should press
--   the default button.
--
entrySetActivatesDefault :: EntryClass ec => ec -> Bool -> IO ()
entrySetActivatesDefault ec setting = {#call entry_set_activates_default#}
  (toEntry ec) (fromBool setting)

-- @method entryGetHasFrame@ Query if the text @ref type Entry@ is displayed
-- with a frame around it.
--
entryGetHasFrame :: EntryClass ec => ec -> IO Bool
entryGetHasFrame ec = liftM toBool $
  {#call unsafe entry_get_has_frame#} (toEntry ec)

-- @method entrySetHasFrame@ Specifies whehter the @ref type Entry@ should be
-- in an etched-in frame.
--
entrySetHasFrame :: EntryClass ec => ec -> Bool -> IO ()
entrySetHasFrame ec setting = {#call entry_set_has_frame#}
  (toEntry ec) (fromBool setting)

-- @method entryGetWidthChars@ Retrieve the number of characters the widget
-- should ask for.
--
entryGetWidthChars :: EntryClass ec => ec -> IO Int
entryGetWidthChars ec = liftM fromIntegral $
  {#call unsafe entry_get_width_chars#} (toEntry ec)

-- @method entrySetWidthChars@ Specifies how large the @ref type Entry@ should
-- be in characters.
--
-- * This setting is only considered when the widget formulates its size
--   request. Make sure that it is not mapped (shown) before you change this
--   value.
--
entrySetWidthChars :: EntryClass ec => ec -> Int -> IO ()
entrySetWidthChars ec setting = {#call entry_set_width_chars#}
  (toEntry ec) (fromIntegral setting)

-- signals

-- @signal connectToEntryActivate@ Emitted when the user presses return within
-- the @ref arg Entry@ field.
--
onEntryActivate, afterEntryActivate :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onEntryActivate = connect_NONE__NONE "activate" False
afterEntryActivate = connect_NONE__NONE "activate" True

-- @signal connectToEntryChanged@ Emitted when the settings of the
-- @ref arg Entry@ widget changes.
--
onEntryChanged, afterEntryChanged :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEntryChanged = connect_NONE__NONE "changed" False
afterEntryChanged = connect_NONE__NONE "changed" True

-- @signal connectToCopyClipboard@ Emitted when the current selection has been
-- copied to the clipboard.
--
onCopyClipboard, afterCopyClipboard :: EntryClass ec => ec -> IO () ->
                                       IO (ConnectId ec)
onCopyClipboard = connect_NONE__NONE "copy_clipboard" False
afterCopyClipboard = connect_NONE__NONE "copy_clipboard" True

-- @signal connectToCutClipboard@ Emitted when the current selection has been
-- cut to the clipboard.
--
onCutClipboard, afterCutClipboard :: EntryClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onCutClipboard = connect_NONE__NONE "cut_clipboard" False
afterCutClipboard = connect_NONE__NONE "cut_clipboard" True

-- @signal connectToPasteClipboard@ Emitted when the current selection has
-- been pasted from the clipboard.
--
onPasteClipboard, afterPasteClipboard :: EntryClass ec => ec -> IO () ->
                                         IO (ConnectId ec)
onPasteClipboard = connect_NONE__NONE "paste_clipboard" False
afterPasteClipboard = connect_NONE__NONE "paste_clipboard" True

-- @signal connectToDeleteText@ Emitted when a piece of text is deleted from
-- the @ref arg Entry@.
--
onDeleteText, afterDeleteText :: EntryClass ec => ec ->
                                 (Int -> Int -> IO ()) -> IO (ConnectId ec)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True

-- @signal connectToInsertAtCursor@ Emitted when a piece of text is inserted
-- at the cursor position.
--
onInsertAtCursor, afterInsertAtCursor :: EntryClass ec => ec ->
                                         (String -> IO ()) ->
                                         IO (ConnectId ec)
onInsertAtCursor = connect_STRING__NONE "insert_at_cursor" False
afterInsertAtCursor = connect_STRING__NONE "insert_at_cursor" True

-- @signal connectToToggleOverwrite@ Emitted when the user changes from
-- overwriting to inserting.
--
onToggleOverwrite, afterToggleOverwrite :: EntryClass ec => ec -> IO () ->
                                           IO (ConnectId ec)
onToggleOverwrite = connect_NONE__NONE "toggle_overwrite" False
afterToggleOverwrite = connect_NONE__NONE "toggle_overwrite" True


Declare exports in ByteBuffer module.

Declare exports in ByteBuffer module.

-- Copyright (c) 2016, Google Inc.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of Google Inc. nor the
--       names of its contributors may be used to endorse or promote products
--       derived from this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL Google Inc. BE LIABLE FOR ANY
-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--
--------------------------------------------------------------------------------
{-# LANGUAGE StandaloneDeriving, ForeignFunctionInterface, OverloadedStrings #-}
module Network.Grpc.Lib.ByteBuffer
  ( CByteBuffer
  , fromByteString
  , addBBFinalizer
  , toLazyByteString

  , CByteBufferReader
  ) where

import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Ptr

import Control.Exception (bracket)

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Lazy as L

#include <grpc/byte_buffer.h>
#include <grpc/byte_buffer_reader.h>
#include "hs_byte_buffer.h"

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

data CByteBuffer
{#pointer *byte_buffer as ByteBuffer foreign -> CByteBuffer#}
data CByteBufferReader
{#pointer *byte_buffer_reader as ByteBufferReader -> CByteBufferReader#}

data CSlice
{#pointer *gpr_slice as Slice -> CSlice#}

fromByteString :: ByteString -> IO ByteBuffer
fromByteString = hsRawByteBufferCreate

withByteString :: ByteString -> ((Ptr CChar, CULong) -> IO a) -> IO a
withByteString bs act = do
  let (fPtr, offset, len) = B.toForeignPtr bs
  withForeignPtr fPtr $ \ptr -> act (ptr `plusPtr` offset, fromIntegral len)

{#fun unsafe hs_raw_byte_buffer_create as ^
  {withByteString* `ByteString'&} -> `ByteBuffer' addBBFinalizer* #}

addBBFinalizer :: Ptr CByteBuffer -> IO ByteBuffer
addBBFinalizer bb = newForeignPtr grpc_byte_buffer_destroy bb

foreign import ccall "Network/Grpc/Core/ByteBuffer.chs.h &grpc_byte_buffer_destroy"
  grpc_byte_buffer_destroy :: FinalizerPtr CByteBuffer

toByteString :: Slice -> IO ByteString
toByteString slice = do
  refcount <- {#get gpr_slice->refcount#} slice
  if refcount == nullPtr
    then fromInlined
    else fromRefcounted
  where
    fromInlined = do
      len <- {#get gpr_slice->data.inlined.length#} slice
      ptr <- {#get gpr_slice->data.inlined.bytes#} slice
      B.packCStringLen (castPtr ptr, fromIntegral len)
    fromRefcounted = do
      len <- {#get gpr_slice->data.refcounted.length#} slice
      ptr <- {#get gpr_slice->data.refcounted.bytes#} slice
      B.packCStringLen (castPtr ptr, fromIntegral len)

toLazyByteString :: ByteBuffer -> IO L.ByteString
toLazyByteString bb =
  bracket
    (byteBufferReaderInit bb)
    (byteBufferReaderDestroy)
    (\bbr -> L.fromChunks <$> go bbr [])
  where
    go bbr acc = do
      (tag, slice) <- byteBufferReaderNext bbr
      case tag of
        0 -> return $ reverse acc
        _ -> do
          bs <- toByteString slice
          go bbr (bs:acc)

{#fun unsafe byte_buffer_reader_init as ^
  {allocaByteBufferReader- `ByteBufferReader' id, `ByteBuffer'} -> `()' #}

allocaSlice :: (Slice -> IO a) -> IO a
allocaSlice act = do
  allocaBytes {#sizeof gpr_slice#} $ \p -> act p

allocaByteBufferReader :: (ByteBufferReader -> IO a) -> IO a
allocaByteBufferReader act = do
  allocaBytes {#sizeof grpc_byte_buffer_reader#} $ \p -> act p

{#fun unsafe byte_buffer_reader_next as ^
  {`ByteBufferReader', allocaSlice- `Slice' id} -> `Int' fromIntegral#}

{#fun unsafe byte_buffer_reader_destroy as ^
  {`ByteBufferReader'} -> `()'#}

-- Copyright (c) 2016, Google Inc.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of Google Inc. nor the
--       names of its contributors may be used to endorse or promote products
--       derived from this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL Google Inc. BE LIABLE FOR ANY
-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--
--------------------------------------------------------------------------------
{-# LANGUAGE StandaloneDeriving, ForeignFunctionInterface, OverloadedStrings #-}
module Network.Grpc.Lib.ByteBuffer where

import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Ptr

import Control.Exception (bracket)

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Lazy as L

#include <grpc/byte_buffer.h>
#include <grpc/byte_buffer_reader.h>
#include "hs_byte_buffer.h"

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

data CByteBuffer
{#pointer *byte_buffer as ByteBuffer foreign -> CByteBuffer#}
data CByteBufferReader
{#pointer *byte_buffer_reader as ByteBufferReader -> CByteBufferReader#}

data CSlice
{#pointer *gpr_slice as Slice -> CSlice#}

fromByteString :: ByteString -> IO ByteBuffer
fromByteString = hsRawByteBufferCreate

withByteString :: ByteString -> ((Ptr CChar, CULong) -> IO a) -> IO a
withByteString bs act = do
  let (fPtr, offset, len) = B.toForeignPtr bs
  withForeignPtr fPtr $ \ptr -> act (ptr `plusPtr` offset, fromIntegral len)

{#fun unsafe hs_raw_byte_buffer_create as ^
  {withByteString* `ByteString'&} -> `ByteBuffer' addBBFinalizer* #}

addBBFinalizer :: Ptr CByteBuffer -> IO ByteBuffer
addBBFinalizer bb = newForeignPtr grpc_byte_buffer_destroy bb

foreign import ccall "Network/Grpc/Core/ByteBuffer.chs.h &grpc_byte_buffer_destroy"
  grpc_byte_buffer_destroy :: FinalizerPtr CByteBuffer

toByteString :: Slice -> IO ByteString
toByteString slice = do
  refcount <- {#get gpr_slice->refcount#} slice
  if refcount == nullPtr
    then fromInlined
    else fromRefcounted
  where
    fromInlined = do
      len <- {#get gpr_slice->data.inlined.length#} slice
      ptr <- {#get gpr_slice->data.inlined.bytes#} slice
      B.packCStringLen (castPtr ptr, fromIntegral len)
    fromRefcounted = do
      len <- {#get gpr_slice->data.refcounted.length#} slice
      ptr <- {#get gpr_slice->data.refcounted.bytes#} slice
      B.packCStringLen (castPtr ptr, fromIntegral len)

toLazyByteString :: ByteBuffer -> IO L.ByteString
toLazyByteString bb =
  bracket
    (byteBufferReaderInit bb)
    (byteBufferReaderDestroy)
    (\bbr -> L.fromChunks <$> go bbr [])
  where
    go bbr acc = do
      (tag, slice) <- byteBufferReaderNext bbr
      case tag of
        0 -> return $ reverse acc
        _ -> do
          bs <- toByteString slice
          go bbr (bs:acc)

{#fun unsafe byte_buffer_reader_init as ^
  {allocaByteBufferReader- `ByteBufferReader' id, `ByteBuffer'} -> `()' #}

allocaSlice :: (Slice -> IO a) -> IO a
allocaSlice act = do
  allocaBytes {#sizeof gpr_slice#} $ \p -> act p

allocaByteBufferReader :: (ByteBufferReader -> IO a) -> IO a
allocaByteBufferReader act = do
  allocaBytes {#sizeof grpc_byte_buffer_reader#} $ \p -> act p

{#fun unsafe byte_buffer_reader_next as ^
  {`ByteBufferReader', allocaSlice- `Slice' id} -> `Int' fromIntegral#}

{#fun unsafe byte_buffer_reader_destroy as ^
  {`ByteBufferReader'} -> `()'#}


[project @ 2004-12-18 20:45:50 by duncan_coutts]

tidy up module header

darcs-hash:20041218204550-d6ff7-7e19ee70f68095c60f429d83c90a00fe8536141c.gz

-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget embedding the Mozilla browser engine (Gecko)
--
--  Author : Jonas Svensson
--
--  Created: 26 February 2002
--
--  Version $Revision: 1.2 $ from $Date: 2004/12/18 20:45:50 $
--
--  Copyright (c) 2002 Jonas Svensson
--
--  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.
--
--  Modified 2004 by Scott West for basic use in gtk2hs
--
--  Further modified 2004 by Wolfram Kahl:
--  * ported to gtk2hs/c2hs
--  * added additional interface functions
--  * circumvented render_data problem
--
-- | This widgets embeds Mozilla's browser engine (Gecko) into a GTK+ widget.
-- See <http://www.mozilla.org/unix/gtk-embedding.html> for an API reference.
--
module Graphics.UI.Gtk.MozEmbed (
  MozEmbed, MozEmbedClass,

  mozEmbedNew, mozEmbedSetCompPath,

  mozEmbedRenderData,
  mozEmbedOpenStream, mozEmbedAppendData, mozEmbedCloseStream,

  onOpenURI,

  mozEmbedLoadUrl,

  -- the functions below are untested.

  onKeyDown, onKeyPress, onKeyUp,
  onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
  onMouseOver, onMouseOut,

  mozEmbedSetProfilePath,
  mozEmbedStopLoad, mozEmbedGoBack, mozEmbedGoForward, mozEmbedGetLinkMessage,
  mozEmbedGetJsStatus, mozEmbedGetTitle, mozEmbedGetLocation,
  mozEmbedCanGoBack, mozEmbedCanGoForward, mozEmbedPushStartup,
  mozEmbedPopStartup
) where

import Monad		(liftM)
import FFI
import ForeignPtr
import Foreign.Marshal.Utils (toBool)

{#import Object#}    (makeNewObject)
{#import Signal#}    (ConnectId, connect_STRING__BOOL, connect_PTR__INT)
{#import Graphics.UI.Gtk.MozEmbedType #}
import Widget (Widget)

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

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

-- | Create a new MozEmbed
--
mozEmbedNew :: IO MozEmbed
mozEmbedNew = makeNewObject mkMozEmbed $ liftM castPtr {#call moz_embed_new#}

mozEmbedSetCompPath :: String -> IO ()
mozEmbedSetCompPath str =
  withCString str $ \strPtr ->
   {#call moz_embed_set_comp_path#}
   strPtr

mozEmbedSetProfilePath :: String -> String -> IO ()
mozEmbedSetProfilePath dir name =
  withCString dir $ \dirPtr ->
   withCString name $ \namePtr ->
    {#call moz_embed_set_profile_path#} dirPtr namePtr

mozEmbedLoadUrl :: MozEmbedClass m => m -> String -> IO ()
mozEmbedLoadUrl m url =
  withCString url $ \urlPtr ->
   {#call moz_embed_load_url#}
   (toMozEmbed m)
   urlPtr

mozEmbedStopLoad :: MozEmbedClass m => m -> IO ()
mozEmbedStopLoad m =
  {#call moz_embed_stop_load#} (toMozEmbed m)

mozEmbedGoBack :: MozEmbedClass m => m -> IO ()
mozEmbedGoBack m =
  {#call moz_embed_go_back#} (toMozEmbed m)

mozEmbedGoForward :: MozEmbedClass m => m -> IO ()
mozEmbedGoForward m =
  {#call moz_embed_go_forward#} (toMozEmbed m)

mozEmbedGetLinkMessage :: MozEmbedClass m => m -> IO String
mozEmbedGetLinkMessage m =
  do
   str <- {#call moz_embed_get_link_message#} (toMozEmbed m)
   peekCString str

mozEmbedGetJsStatus :: MozEmbedClass m => m -> IO String
mozEmbedGetJsStatus m =
  do
   str <- {#call moz_embed_get_js_status#} (toMozEmbed m)
   peekCString str

mozEmbedGetTitle :: MozEmbedClass m => m -> IO String
mozEmbedGetTitle m =
  do
   str <- {#call moz_embed_get_title#} (toMozEmbed m)
   peekCString str

mozEmbedGetLocation :: MozEmbedClass m => m -> IO String
mozEmbedGetLocation m =
  do
   str <- {#call moz_embed_get_location#} (toMozEmbed m)
   peekCString str

mozEmbedCanGoBack :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoBack m =
  liftM toBool $
   {#call moz_embed_can_go_back#} (toMozEmbed m)

mozEmbedCanGoForward :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoForward m =
  liftM toBool $
   {#call moz_embed_can_go_forward#} (toMozEmbed m)

mozEmbedPushStartup :: IO ()
mozEmbedPushStartup =
  {#call moz_embed_push_startup#}

mozEmbedPopStartup :: IO ()
mozEmbedPopStartup =
  {#call moz_embed_pop_startup#}

{-
void         gtk_moz_embed_open_stream      (GtkMozEmbed *embed,
					     const char *base_uri,
					     const char *mime_type);
void         gtk_moz_embed_append_data      (GtkMozEmbed *embed,
					     const char *data, guint32 len);
void         gtk_moz_embed_close_stream     (GtkMozEmbed *embed);
-}

mozEmbedOpenStream :: MozEmbedClass m => m -> String -> String -> IO ()
mozEmbedOpenStream m baseURI mimeType =
  withCString baseURI  $ \ basePtr ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_open_stream#} (toMozEmbed m) basePtr mtPtr

mozEmbedAppendDataInternal :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendDataInternal m contents =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged?
  let len' = fromIntegral len in
  {#call gtk_moz_embed_append_data#} (toMozEmbed m) dataPtr len'
--  >> free dataPtr

mozEmbedCloseStream :: MozEmbedClass m => m -> IO ()
mozEmbedCloseStream m =
  {#call gtk_moz_embed_close_stream#} (toMozEmbed m)

mozEmbedAppendData :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendData m contents =
  mapM_ (mozEmbedAppendDataInternal m) (chunks 32768 contents)

mozEmbedRenderData :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderData m contents baseURI mimeType = do
  mozEmbedOpenStream m baseURI mimeType
  mozEmbedAppendData m contents
  mozEmbedCloseStream m

chunks :: Int -> [a] -> [[a]]
chunks n [] = []
chunks n xs = let (ys, zs) = splitAt n xs in ys : chunks n zs

{-
void         gtk_moz_embed_render_data      (GtkMozEmbed *embed,
                                             const char *data,
                                             guint32 len,
                                             const char *base_uri,
                                             const char *mime_type)
-}
--  -- mozEmbedRenderDataInternal does not work for len' > 2^16
mozEmbedRenderDataInternal :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderDataInternal m contents baseURI mimeType =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged
  let len' = fromIntegral len in
--  hPutStrLn stderr ("mozEmbedRenderData: " ++ shows len' " bytes") >>= \ _ ->
  withCString baseURI  $ \ basePrt ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_render_data#} (toMozEmbed m) dataPtr len' basePrt mtPtr
--  >> free dataPtr

{-
struct _GtkMozEmbedClass
{
  [...]
  gint (* open_uri)            (GtkMozEmbed *embed, const char *aURI);
  [...]
}
-}

onOpenURI :: MozEmbedClass m => m -> (String -> IO Bool) -> IO (ConnectId m)
onOpenURI = connect_STRING__BOOL "open_uri" after
 where
-- Specify if the handler is to run before (False) or after (True) the
-- default handler.
  after = False

{-
More signals to investigate:

  gint (* dom_key_down)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_press)       (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_up)          (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_down)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_up)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_click)     (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_dbl_click) (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_over)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_out)       (GtkMozEmbed *embed, gpointer dom_event);

Unfortunateley these are not documented on

http://www.mozilla.org/unix/gtk-embedding.html

-}

onKeyDown, onKeyPress, onKeyUp,
 onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
 onMouseOver, onMouseOut
 :: (Num n, Integral n, MozEmbedClass m)
 => m -> (Ptr a -> IO n) -> IO (ConnectId m)
onKeyDown          = connect_PTR__INT "dom_key_down" False
onKeyPress         = connect_PTR__INT "dom_key_press" False
onKeyUp            = connect_PTR__INT "dom_key_up" False
onMouseDown        = connect_PTR__INT "dom_mouse_down" False
onMouseUp          = connect_PTR__INT "dom_mouse_up" False
onMouseClick       = connect_PTR__INT "dom_mouse_click" False
onMouseDoubleClick = connect_PTR__INT "dom_mouse_dbl_click" False
onMouseOver        = connect_PTR__INT "dom_mouse_over" False
onMouseOut         = connect_PTR__INT "dom_mouse_out" False

-- |GIMP Toolkit (GTK) Binding for Haskell: widget embedding the  -*-haskell-*-
--    Mozilla browser engine (Gecko)
--
--  Author : Jonas Svensson
--  Created: 26 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2004/12/17 21:21:44 $
--
--  Copyright (c) 2002 Jonas Svensson
--
--  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.
--
--
--  Modified 2004 by Scott West for basic use in gtk2hs
--
--  Further modified 2004 by Wolfram Kahl:
--  * ported to gtk2hs/c2hs
--  * added additional interface functions
--  * circumvented render_data problem
--
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  This widgets embeds Mozilla's browser engine (Gecko) into a GTK+ widget.
--
--- DOCU ----------------------------------------------------------------------
--
--  Language: Haskell 98 Binding Module
--
--- TODO ----------------------------------------------------------------------
--

module Graphics.UI.Gtk.MozEmbed (
  MozEmbed, MozEmbedClass,

  mozEmbedNew, mozEmbedSetCompPath,

  mozEmbedRenderData,
  mozEmbedOpenStream, mozEmbedAppendData, mozEmbedCloseStream,

  onOpenURI,

  mozEmbedLoadUrl,

  -- the functions below are untested.

  onKeyDown, onKeyPress, onKeyUp,
  onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
  onMouseOver, onMouseOut,

  mozEmbedSetProfilePath,
  mozEmbedStopLoad, mozEmbedGoBack, mozEmbedGoForward, mozEmbedGetLinkMessage,
  mozEmbedGetJsStatus, mozEmbedGetTitle, mozEmbedGetLocation,
  mozEmbedCanGoBack, mozEmbedCanGoForward, mozEmbedPushStartup,
  mozEmbedPopStartup
) where

import Monad		(liftM)
import FFI
import ForeignPtr
import Foreign.Marshal.Utils (toBool)

{#import Object#}    (makeNewObject)
{#import Signal#}    (ConnectId, connect_STRING__BOOL, connect_PTR__INT)
{#import Graphics.UI.Gtk.MozEmbedType #}
import Widget (Widget)

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

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

-- | Create a new MozEmbed
--
mozEmbedNew :: IO MozEmbed
mozEmbedNew = makeNewObject mkMozEmbed $ liftM castPtr {#call moz_embed_new#}

mozEmbedSetCompPath :: String -> IO ()
mozEmbedSetCompPath str =
  withCString str $ \strPtr ->
   {#call moz_embed_set_comp_path#}
   strPtr

mozEmbedSetProfilePath :: String -> String -> IO ()
mozEmbedSetProfilePath dir name =
  withCString dir $ \dirPtr ->
   withCString name $ \namePtr ->
    {#call moz_embed_set_profile_path#} dirPtr namePtr

mozEmbedLoadUrl :: MozEmbedClass m => m -> String -> IO ()
mozEmbedLoadUrl m url =
  withCString url $ \urlPtr ->
   {#call moz_embed_load_url#}
   (toMozEmbed m)
   urlPtr

mozEmbedStopLoad :: MozEmbedClass m => m -> IO ()
mozEmbedStopLoad m =
  {#call moz_embed_stop_load#} (toMozEmbed m)

mozEmbedGoBack :: MozEmbedClass m => m -> IO ()
mozEmbedGoBack m =
  {#call moz_embed_go_back#} (toMozEmbed m)

mozEmbedGoForward :: MozEmbedClass m => m -> IO ()
mozEmbedGoForward m =
  {#call moz_embed_go_forward#} (toMozEmbed m)

mozEmbedGetLinkMessage :: MozEmbedClass m => m -> IO String
mozEmbedGetLinkMessage m =
  do
   str <- {#call moz_embed_get_link_message#} (toMozEmbed m)
   peekCString str

mozEmbedGetJsStatus :: MozEmbedClass m => m -> IO String
mozEmbedGetJsStatus m =
  do
   str <- {#call moz_embed_get_js_status#} (toMozEmbed m)
   peekCString str

mozEmbedGetTitle :: MozEmbedClass m => m -> IO String
mozEmbedGetTitle m =
  do
   str <- {#call moz_embed_get_title#} (toMozEmbed m)
   peekCString str

mozEmbedGetLocation :: MozEmbedClass m => m -> IO String
mozEmbedGetLocation m =
  do
   str <- {#call moz_embed_get_location#} (toMozEmbed m)
   peekCString str

mozEmbedCanGoBack :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoBack m =
  liftM toBool $
   {#call moz_embed_can_go_back#} (toMozEmbed m)

mozEmbedCanGoForward :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoForward m =
  liftM toBool $
   {#call moz_embed_can_go_forward#} (toMozEmbed m)

mozEmbedPushStartup :: IO ()
mozEmbedPushStartup =
  {#call moz_embed_push_startup#}

mozEmbedPopStartup :: IO ()
mozEmbedPopStartup =
  {#call moz_embed_pop_startup#}

{-
void         gtk_moz_embed_open_stream      (GtkMozEmbed *embed,
					     const char *base_uri,
					     const char *mime_type);
void         gtk_moz_embed_append_data      (GtkMozEmbed *embed,
					     const char *data, guint32 len);
void         gtk_moz_embed_close_stream     (GtkMozEmbed *embed);
-}

mozEmbedOpenStream :: MozEmbedClass m => m -> String -> String -> IO ()
mozEmbedOpenStream m baseURI mimeType =
  withCString baseURI  $ \ basePtr ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_open_stream#} (toMozEmbed m) basePtr mtPtr

mozEmbedAppendDataInternal :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendDataInternal m contents =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged?
  let len' = fromIntegral len in
  {#call gtk_moz_embed_append_data#} (toMozEmbed m) dataPtr len'
--  >> free dataPtr

mozEmbedCloseStream :: MozEmbedClass m => m -> IO ()
mozEmbedCloseStream m =
  {#call gtk_moz_embed_close_stream#} (toMozEmbed m)

mozEmbedAppendData :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendData m contents =
  mapM_ (mozEmbedAppendDataInternal m) (chunks 32768 contents)

mozEmbedRenderData :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderData m contents baseURI mimeType = do
  mozEmbedOpenStream m baseURI mimeType
  mozEmbedAppendData m contents
  mozEmbedCloseStream m

chunks :: Int -> [a] -> [[a]]
chunks n [] = []
chunks n xs = let (ys, zs) = splitAt n xs in ys : chunks n zs

{-
void         gtk_moz_embed_render_data      (GtkMozEmbed *embed,
                                             const char *data,
                                             guint32 len,
                                             const char *base_uri,
                                             const char *mime_type)
-}
--  -- mozEmbedRenderDataInternal does not work for len' > 2^16
mozEmbedRenderDataInternal :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderDataInternal m contents baseURI mimeType =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged
  let len' = fromIntegral len in
--  hPutStrLn stderr ("mozEmbedRenderData: " ++ shows len' " bytes") >>= \ _ ->
  withCString baseURI  $ \ basePrt ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_render_data#} (toMozEmbed m) dataPtr len' basePrt mtPtr
--  >> free dataPtr

{-
struct _GtkMozEmbedClass
{
  [...]
  gint (* open_uri)            (GtkMozEmbed *embed, const char *aURI);
  [...]
}
-}

onOpenURI :: MozEmbedClass m => m -> (String -> IO Bool) -> IO (ConnectId m)
onOpenURI = connect_STRING__BOOL "open_uri" after
 where
-- Specify if the handler is to run before (False) or after (True) the
-- default handler.
  after = False

{-
More signals to investigate:

  gint (* dom_key_down)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_press)       (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_up)          (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_down)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_up)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_click)     (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_dbl_click) (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_over)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_out)       (GtkMozEmbed *embed, gpointer dom_event);

Unfortunateley these are not documented on

http://www.mozilla.org/unix/gtk-embedding.html

-}

onKeyDown, onKeyPress, onKeyUp,
 onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
 onMouseOver, onMouseOut
 :: (Num n, Integral n, MozEmbedClass m)
 => m -> (Ptr a -> IO n) -> IO (ConnectId m)
onKeyDown          = connect_PTR__INT "dom_key_down" False
onKeyPress         = connect_PTR__INT "dom_key_press" False
onKeyUp            = connect_PTR__INT "dom_key_up" False
onMouseDown        = connect_PTR__INT "dom_mouse_down" False
onMouseUp          = connect_PTR__INT "dom_mouse_up" False
onMouseClick       = connect_PTR__INT "dom_mouse_click" False
onMouseDoubleClick = connect_PTR__INT "dom_mouse_dbl_click" False
onMouseOver        = connect_PTR__INT "dom_mouse_over" False
onMouseOut         = connect_PTR__INT "dom_mouse_out" False