{-# LINE 2 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget SourceCompletionInfo
--
-- Author : Andy Stewart
--
-- Created: 08 Aug 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.SourceView.SourceCompletionInfo (
-- * Description
-- | This object can be used to show a calltip or help for the .* current completion proposal.

-- * Types
   SourceCompletionInfo,
   SourceCompletionInfoClass,

-- * Methods
   sourceCompletionInfoNew,
   sourceCompletionInfoMoveToIter,
   sourceCompletionInfoSetSizing,
   sourceCompletionInfoSetWidget,
   sourceCompletionInfoGetWidget,
   sourceCompletionInfoProcessResize,

-- * Attributes
   sourceCompletionInfoMaxHeight,
   sourceCompletionInfoMaxWidth,
   sourceCompletionInfoShrinkHeight,
   sourceCompletionInfoShrinkWidth,

-- * Signals
   sourceCompletionInfoBeforeShow,
) where
import Control.Monad (liftM)
import Data.Maybe (fromMaybe)

import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.GObject (makeNewGObject)
import System.Glib.Properties
import System.Glib.UTFString

import Graphics.UI.Gtk.SourceView.Signals
{-# LINE 62 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}
import Graphics.UI.Gtk.SourceView.Types
{-# LINE 63 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}


{-# LINE 65 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}

-- |
sourceCompletionInfoNew :: IO SourceCompletionInfo
sourceCompletionInfoNew =
  makeNewObject mkSourceCompletionInfo $
  gtk_source_completion_info_new
{-# LINE 71 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}

-- | Moves the 'SourceCompletionInfo' to iter. If iter is 'Nothing' info is moved to the cursor
-- position. Moving will respect the 'Gravity' setting of the info window and will ensure the line at
-- iter is not occluded by the window.
sourceCompletionInfoMoveToIter :: SourceCompletionInfoClass info => info
                               -> TextView -- ^ @view@ A 'TextView' on which the info window should be positioned
                               -> Maybe TextIter -- ^ @iter@ A 'TextIter' or 'Nothing'
                               -> IO ()
sourceCompletionInfoMoveToIter info view iter =
  (\(SourceCompletionInfo arg1) (TextView arg2) (TextIter arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gtk_source_completion_info_move_to_iter argPtr1 argPtr2 argPtr3)
{-# LINE 81 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}
    (toSourceCompletionInfo info)
    view
    (fromMaybe (TextIter nullForeignPtr) iter)

-- | Set sizing information for the info window. If @shrinkWidth@ or @shrinkHeight@ is 'True', the info
-- window will try to resize to fit the window contents, with a maximum size given by width and
-- height. Setting width or height to -1 removes the maximum size of respectively the width and height
-- of the window.
sourceCompletionInfoSetSizing :: SourceCompletionInfoClass info => info
                              -> Int -- ^ @width@ The maximum/requested width of the window (-1 to default)
                              -> Int -- ^ @height@ The maximum/requested height of the window (-1 to default)
                              -> Bool -- ^ @shrinkWidth@ Whether to shrink the width of the window to fit its contents
                              -> Bool -- ^ @shrinkHeight@ Whether to shrink the height of the window to fit its contents
                              -> IO ()
sourceCompletionInfoSetSizing info width height shrinkWidth shrinkHeight =
  (\(SourceCompletionInfo arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_completion_info_set_sizing argPtr1 arg2 arg3 arg4 arg5)
{-# LINE 97 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}
     (toSourceCompletionInfo info)
     (fromIntegral width)
     (fromIntegral height)
     (fromBool shrinkWidth)
     (fromBool shrinkHeight)

-- | Sets the content widget of the info window. If widget does not fit within the size requirements of
-- the window, a 'ScrolledWindow' will automatically be created and added to the window.
sourceCompletionInfoSetWidget :: (SourceCompletionInfoClass info, WidgetClass widget) => info
                              -> widget
                              -> IO ()
sourceCompletionInfoSetWidget info widget =
  (\(SourceCompletionInfo arg1) (Widget arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_source_completion_info_set_widget argPtr1 argPtr2)
{-# LINE 110 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}
    (toSourceCompletionInfo info)
    (toWidget widget)

-- | Get the current content widget.
sourceCompletionInfoGetWidget :: SourceCompletionInfoClass info => info
                              -> IO Widget -- ^ returns The current content widget.
sourceCompletionInfoGetWidget info =
  makeNewObject mkWidget $
  (\(SourceCompletionInfo arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_completion_info_get_widget argPtr1)
{-# LINE 119 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}
     (toSourceCompletionInfo info)

-- |
sourceCompletionInfoProcessResize :: SourceCompletionInfoClass info => info
                                  -> IO ()
sourceCompletionInfoProcessResize info =
  (\(SourceCompletionInfo arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_source_completion_info_process_resize argPtr1)
{-# LINE 126 "./Graphics/UI/Gtk/SourceView/SourceCompletionInfo.chs" #-}
     (toSourceCompletionInfo info)

-- | The maximum allowed height.
--
-- Allowed values: >= GMaxulong
--
-- Default value: -1
sourceCompletionInfoMaxHeight :: SourceCompletionInfoClass info => Attr info Int
sourceCompletionInfoMaxHeight = newAttrFromIntProperty "max-height"

-- | The maximum allowed width.
--
-- Allowed values: >= GMaxulong
--
-- Default value: -1
sourceCompletionInfoMaxWidth :: SourceCompletionInfoClass info => Attr info Int
sourceCompletionInfoMaxWidth = newAttrFromIntProperty "max-width"

-- | Whether the window should shrink height to fit the contents.
--
-- Default value: 'True'
sourceCompletionInfoShrinkHeight :: SourceCompletionInfoClass info => Attr info Bool
sourceCompletionInfoShrinkHeight = newAttrFromBoolProperty "shrink-height"

-- | Whether the window should shrink width to fit the contents.
--
-- Default value: 'True'
sourceCompletionInfoShrinkWidth :: SourceCompletionInfoClass info => Attr info Bool
sourceCompletionInfoShrinkWidth = newAttrFromBoolProperty "shrink-width"

-- |
sourceCompletionInfoBeforeShow :: SourceCompletionInfoClass info => Signal info (IO ())
sourceCompletionInfoBeforeShow = Signal $ connect_NONE__NONE "before-show"

foreign import ccall safe "gtk_source_completion_info_new"
  gtk_source_completion_info_new :: (IO (Ptr SourceCompletionInfo))

foreign import ccall safe "gtk_source_completion_info_move_to_iter"
  gtk_source_completion_info_move_to_iter :: ((Ptr SourceCompletionInfo) -> ((Ptr TextView) -> ((Ptr TextIter) -> (IO ()))))

foreign import ccall safe "gtk_source_completion_info_set_sizing"
  gtk_source_completion_info_set_sizing :: ((Ptr SourceCompletionInfo) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO ()))))))

foreign import ccall safe "gtk_source_completion_info_set_widget"
  gtk_source_completion_info_set_widget :: ((Ptr SourceCompletionInfo) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_source_completion_info_get_widget"
  gtk_source_completion_info_get_widget :: ((Ptr SourceCompletionInfo) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_source_completion_info_process_resize"
  gtk_source_completion_info_process_resize :: ((Ptr SourceCompletionInfo) -> (IO ()))