strictness

strictness

{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables      #-}
-- |
-- Module      : Foreign.LibNVVM.Compile
-- Copyright   : 2012 Sean Lee
--               2014 Trevor L. McDonell
-- License     :
--
-- Maintainer  : Sean Lee <selee@nvidia.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
module Foreign.LibNVVM.Compile (

  -- * Compilation result
  Result(..), CompileFlag(..), VerifyFlag,

  -- * Compilation
  compileModule, compileModules,

) where

import Prelude                                          hiding ( log )
import Data.ByteString                                  ( ByteString )
import Data.Word
import Control.Exception
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8                  as B
import qualified Data.ByteString.Unsafe                 as B
import qualified Data.ByteString.Internal               as B

import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Storable
import Foreign.CUDA.Analysis
import Foreign.LibNVVM.Error
import Foreign.LibNVVM.Internal

#include <nvvm.h>

{# context lib="nvvm" #}

-- | The return type of compiling a module(s) is the compilation log together
-- with the resulting binary ptx/cubin.
--
data Result = Result {
    -- | Any compilation or verification messages and warnings that were
    -- generated during compilation of the NVVM module. Note that even upon
    -- successful completion, the log may not be empty.
    --
    nvvmLog       :: {-# UNPACK #-} !ByteString
  , nvvmResult    :: {-# UNPACK #-} !ByteString
  }

-- | An opaque handle to an NVVM program
--
newtype Program = Program { useProgram :: {# type nvvmProgram #}}
  deriving (Eq, Show)

-- | The available program compilation flags
--
data CompileFlag
    -- | Level of optimisation to apply (0-3) (Default: 3)
  = OptimisationLevel !Int

    -- | Compute architecture to target (Default: Compute 2.0)
  | Target !Compute

    -- | Flush denormal values to zero when performing single-precision floating
    -- point operations (Default: preserve denormal values)
  | FlushToZero

    -- | Use a faster approximation for single-precision floating-point square
    -- root (Default: use IEEE round-to-nearest mode)
  | FastSqrt

    -- | Use a faster approximation for single-precision floating-point division
    -- and reciprocal operations (Default: use IEEE round-to-nearest mode)
  | FastDiv

    -- | Disable fused-multiply-add contraction (Default: enabled)
  | DisableFMA

    -- | Generate debugging symbols (-g) (Default: no)
  | GenerateDebugInfo

-- | The available program verification flags
--
data VerifyFlag

compileFlagToArg :: CompileFlag -> String
compileFlagToArg f =
  case f of
    OptimisationLevel o  -> printf "-opt=%d" o
    Target (Compute n m) -> printf "-arch=compute_%d%d" n m
    FlushToZero          -> "-ftz=1"
    FastSqrt             -> "-prec-sqrt=0"
    FastDiv              -> "-prec-div=0"
    DisableFMA           -> "-fma=0"
    GenerateDebugInfo    -> "-g"

verifyFlagToArg :: VerifyFlag -> String
verifyFlagToArg _ = error "verifyFlagToArg"

-- High-level interface
-- --------------------

-- | Compile an NVVM IR module according to the specified options. If an error
-- occurs an exception is thrown, otherwise the generated PTX is returned
-- together with any warning or verification messages generated during
-- compilation.
--
-- The input NVVM IR module can be either in the bitcode representation or the
-- text representation.
--
compileModule
    :: String                           -- ^ name of the module (optional)
    -> ByteString                       -- ^ module NVVM IR
    -> [CompileFlag]                    -- ^ compilation options
    -> Bool                             -- ^ verify program?
    -> IO Result
compileModule name bc = compileModules [(name,bc)]

-- | Compile and link multiple NVVM IR modules together to form a single
-- program. The compiled result is represented in PTX.
--
-- Each NVVM IR module may individually be in either the bitcode representation
-- or in the text representation.
--
compileModules
    :: [(String, ByteString)]           -- ^ modules to compile and link
    -> [CompileFlag]                    -- ^ compilation options
    -> Bool                             -- ^ verify program?
    -> IO Result
compileModules modules opts verify =
  bracket create destroy $ \prg -> do
    res <- try $ do
      mapM_ (uncurry (addModule prg)) modules
      when verify (verifyProgram prg [])
      compileProgram prg opts
      compilerResult prg
    log   <- compilerLog prg
    case res of
      Left (err :: NVVMException) -> nvvmError (unlines [show err, B.unpack log])
      Right ptx                   -> return $! Result log ptx

-- The raw interface to libNVVM
-- ----------------------------

-- | Create a new program handle
--
create :: IO Program
create = resultIfOk =<< nvvmCreateProgram

{-# INLINE nvvmCreateProgram #-}
{# fun unsafe nvvmCreateProgram
  { alloca- `Program' peekProgram*
  }
  -> `Status' cToEnum #}
  where
    peekProgram = liftM Program . peek

-- | Destroy a program handle
--
destroy :: Program -> IO ()
destroy p = nothingIfOk =<< nvvmDestroyProgram p

{-# INLINE nvvmDestroyProgram #-}
{# fun unsafe nvvmDestroyProgram
  { withProgram* `Program' } -> `Status' cToEnum #}
  where
    withProgram = with . useProgram

-- | Add an NVVM IR module to the given program compilation unit. An exception
-- is raised if:
--
--   * The 'Program' to add to is invalid; or
--
--   * The NVVM module IR is invalid.
--
addModule :: Program -> String -> ByteString -> IO ()
addModule prg name mdl =
  B.unsafeUseAsCStringLen mdl $ \(b,n) -> do
    nothingIfOk =<< nvvmAddModuleToProgram prg b n name

{-# INLINE nvvmAddModuleToProgram #-}
{# fun unsafe nvvmAddModuleToProgram
  { useProgram    `Program'
  , id            `CString'
  , cIntConv      `Int'
  , withCString'* `String'
  }
  -> `Status' cToEnum #}
  where
    withCString' [] f   = f nullPtr             -- defaults to "<unnamed>"
    withCString' s  f   = withCString s f

-- | Compile the given 'Program' and all modules that have been previously added
-- to it.
--
compileProgram :: Program -> [CompileFlag] -> IO ()
compileProgram prg opts =
  bracket
    (mapM (newCString . compileFlagToArg) opts)
    (mapM free)
    (\args -> nothingIfOk =<< withArrayLen args (nvvmCompileProgram prg))

{-# INLINE nvvmCompileProgram #-}
{# fun unsafe nvvmCompileProgram
  { useProgram  `Program'
  , cIntConv    `Int'
  , id          `Ptr CString'
  }
  -> `Status' cToEnum #}

-- | Retrieve the result of compiling a 'Program' as a 'ByteString' containing
-- the generated PTX. An exception is raised if the compilation unit is invalid.
--
compilerResult :: Program -> IO ByteString
compilerResult prg = do
  n     <- resultIfOk =<< nvvmGetCompiledResultSize prg
  log   <- B.mallocByteString n
  nothingIfOk =<< nvvmGetCompiledResult prg log
  return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator

{-# INLINE nvvmGetCompiledResult #-}
{# fun unsafe nvvmGetCompiledResult
  { useProgram       `Program'
  , withForeignPtr'* `ForeignPtr Word8'
  }
  -> `Status' cToEnum #}
  where
    withForeignPtr' p f = withForeignPtr (castForeignPtr p) f

{-# INLINE nvvmGetCompiledResultSize #-}
{# fun unsafe nvvmGetCompiledResultSize
  { useProgram  `Program'
  , alloca-     `Int'     peekIntConv*
  }
  -> `Status' cToEnum #}

-- | Retrieve the log of compiling a 'Program' as a 'ByteString'.
--
compilerLog :: Program -> IO ByteString
compilerLog prg = do
  n     <- resultIfOk =<< nvvmGetProgramLogSize prg
  log   <- B.mallocByteString n
  nothingIfOk =<< nvvmGetProgramLog prg log
  return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator

{-# INLINE nvvmGetProgramLog #-}
{# fun unsafe nvvmGetProgramLog
  { useProgram       `Program'
  , withForeignPtr'* `ForeignPtr Word8'
  }
  -> `Status' cToEnum #}
  where
    withForeignPtr' p f = withForeignPtr (castForeignPtr p) f

{-# INLINE nvvmGetProgramLogSize #-}
{# fun unsafe nvvmGetProgramLogSize
  { useProgram  `Program'
  , alloca-     `Int'     peekIntConv*
  }
  -> `Status' cToEnum #}

-- | Verify the NVVM program. If an error is encountered, an exception is
-- thrown.
--
verifyProgram :: Program -> [VerifyFlag] -> IO ()
verifyProgram prg opts =
  bracket
    (mapM (newCString . verifyFlagToArg) opts)
    (mapM free)
    (\args -> nothingIfOk =<< withArrayLen args (nvvmVerifyProgram prg))

{# fun unsafe nvvmVerifyProgram
  { useProgram `Program'
  , cIntConv   `Int'
  , id         `Ptr CString'
  }
  -> `Status' cToEnum #}

{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables      #-}
-- |
-- Module      : Foreign.LibNVVM.Compile
-- Copyright   : 2012 Sean Lee
--               2014 Trevor L. McDonell
-- License     :
--
-- Maintainer  : Sean Lee <selee@nvidia.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
module Foreign.LibNVVM.Compile (

  -- * Compilation result
  Result(..), CompileFlag(..), VerifyFlag,

  -- * Compilation
  compileModule, compileModules,

) where

import Prelude                                          hiding ( log )
import Data.ByteString                                  ( ByteString )
import Data.Word
import Control.Exception
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8                  as B
import qualified Data.ByteString.Unsafe                 as B
import qualified Data.ByteString.Internal               as B

import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Storable
import Foreign.CUDA.Analysis
import Foreign.LibNVVM.Error
import Foreign.LibNVVM.Internal

#include <nvvm.h>

{# context lib="nvvm" #}

-- | The return type of compiling a module(s) is the compilation log together
-- with the resulting binary ptx/cubin.
--
data Result = Result {
    -- | Any compilation or verification messages and warnings that were
    -- generated during compilation of the NVVM module. Note that even upon
    -- successful completion, the log may not be empty.
    --
    nvvmLog       :: {-# UNPACK #-} !ByteString
  , nvvmResult    :: {-# UNPACK #-} !ByteString
  }

-- | An opaque handle to an NVVM program
--
newtype Program = Program { useProgram :: {# type nvvmProgram #}}
  deriving (Eq, Show)

-- | The available program compilation flags
--
data CompileFlag
    -- | Level of optimisation to apply (0-3) (Default: 3)
  = OptimisationLevel !Int

    -- | Compute architecture to target (Default: Compute 2.0)
  | Target !Compute

    -- | Flush denormal values to zero when performing single-precision floating
    -- point operations (Default: preserve denormal values)
  | FlushToZero

    -- | Use a faster approximation for single-precision floating-point square
    -- root (Default: use IEEE round-to-nearest mode)
  | FastSqrt

    -- | Use a faster approximation for single-precision floating-point division
    -- and reciprocal operations (Default: use IEEE round-to-nearest mode)
  | FastDiv

    -- | Disable fused-multiply-add contraction (Default: enabled)
  | DisableFMA

    -- | Generate debugging symbols (-g) (Default: no)
  | GenerateDebugInfo

-- | The available program verification flags
--
data VerifyFlag

compileFlagToArg :: CompileFlag -> String
compileFlagToArg f =
  case f of
    OptimisationLevel o  -> printf "-opt=%d" o
    Target (Compute n m) -> printf "-arch=compute_%d%d" n m
    FlushToZero          -> "-ftz=1"
    FastSqrt             -> "-prec-sqrt=0"
    FastDiv              -> "-prec-div=0"
    DisableFMA           -> "-fma=0"
    GenerateDebugInfo    -> "-g"

verifyFlagToArg :: VerifyFlag -> String
verifyFlagToArg _ = error "verifyFlagToArg"

-- High-level interface
-- --------------------

-- | Compile an NVVM IR module according to the specified options. If an error
-- occurs an exception is thrown, otherwise the generated PTX is returned
-- together with any warning or verification messages generated during
-- compilation.
--
-- The input NVVM IR module can be either in the bitcode representation or the
-- text representation.
--
compileModule
    :: String                           -- ^ name of the module (optional)
    -> ByteString                       -- ^ module NVVM IR
    -> [CompileFlag]                    -- ^ compilation options
    -> Bool                             -- ^ verify program?
    -> IO Result
compileModule name bc = compileModules [(name,bc)]

-- | Compile and link multiple NVVM IR modules together to form a single
-- program. The compiled result is represented in PTX.
--
-- Each NVVM IR module may individually be in either the bitcode representation
-- or in the text representation.
--
compileModules
    :: [(String, ByteString)]           -- ^ modules to compile and link
    -> [CompileFlag]                    -- ^ compilation options
    -> Bool                             -- ^ verify program?
    -> IO Result
compileModules modules opts verify =
  bracket create destroy $ \prg -> do
    res <- try $ do
      mapM_ (uncurry (addModule prg)) modules
      when verify (verifyProgram prg [])
      compileProgram prg opts
      compilerResult prg
    log   <- compilerLog prg
    case res of
      Left (err :: NVVMException) -> nvvmError (unlines [show err, B.unpack log])
      Right ptx                   -> return $ Result log ptx

-- The raw interface to libNVVM
-- ----------------------------

-- | Create a new program handle
--
create :: IO Program
create = resultIfOk =<< nvvmCreateProgram

{-# INLINE nvvmCreateProgram #-}
{# fun unsafe nvvmCreateProgram
  { alloca- `Program' peekProgram*
  }
  -> `Status' cToEnum #}
  where
    peekProgram = liftM Program . peek

-- | Destroy a program handle
--
destroy :: Program -> IO ()
destroy p = nothingIfOk =<< nvvmDestroyProgram p

{-# INLINE nvvmDestroyProgram #-}
{# fun unsafe nvvmDestroyProgram
  { withProgram* `Program' } -> `Status' cToEnum #}
  where
    withProgram = with . useProgram

-- | Add an NVVM IR module to the given program compilation unit. An exception
-- is raised if:
--
--   * The 'Program' to add to is invalid; or
--
--   * The NVVM module IR is invalid.
--
addModule :: Program -> String -> ByteString -> IO ()
addModule prg name mdl =
  B.unsafeUseAsCStringLen mdl $ \(b,n) -> do
    nothingIfOk =<< nvvmAddModuleToProgram prg b n name

{-# INLINE nvvmAddModuleToProgram #-}
{# fun unsafe nvvmAddModuleToProgram
  { useProgram    `Program'
  , id            `CString'
  , cIntConv      `Int'
  , withCString'* `String'
  }
  -> `Status' cToEnum #}
  where
    withCString' [] f   = f nullPtr             -- defaults to "<unnamed>"
    withCString' s  f   = withCString s f

-- | Compile the given 'Program' and all modules that have been previously added
-- to it.
--
compileProgram :: Program -> [CompileFlag] -> IO ()
compileProgram prg opts =
  bracket
    (mapM (newCString . compileFlagToArg) opts)
    (mapM free)
    (\args -> nothingIfOk =<< withArrayLen args (nvvmCompileProgram prg))

{-# INLINE nvvmCompileProgram #-}
{# fun unsafe nvvmCompileProgram
  { useProgram  `Program'
  , cIntConv    `Int'
  , id          `Ptr CString'
  }
  -> `Status' cToEnum #}

-- | Retrieve the result of compiling a 'Program' as a 'ByteString' containing
-- the generated PTX. An exception is raised if the compilation unit is invalid.
--
compilerResult :: Program -> IO ByteString
compilerResult prg = do
  n     <- resultIfOk =<< nvvmGetCompiledResultSize prg
  log   <- B.mallocByteString n
  nothingIfOk =<< nvvmGetCompiledResult prg log
  return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator

{-# INLINE nvvmGetCompiledResult #-}
{# fun unsafe nvvmGetCompiledResult
  { useProgram       `Program'
  , withForeignPtr'* `ForeignPtr Word8'
  }
  -> `Status' cToEnum #}
  where
    withForeignPtr' p f = withForeignPtr (castForeignPtr p) f

{-# INLINE nvvmGetCompiledResultSize #-}
{# fun unsafe nvvmGetCompiledResultSize
  { useProgram  `Program'
  , alloca-     `Int'     peekIntConv*
  }
  -> `Status' cToEnum #}

-- | Retrieve the log of compiling a 'Program' as a 'ByteString'.
--
compilerLog :: Program -> IO ByteString
compilerLog prg = do
  n     <- resultIfOk =<< nvvmGetProgramLogSize prg
  log   <- B.mallocByteString n
  nothingIfOk =<< nvvmGetProgramLog prg log
  return $! B.fromForeignPtr log 0 (n-1) -- size includes the NULL terminator

{-# INLINE nvvmGetProgramLog #-}
{# fun unsafe nvvmGetProgramLog
  { useProgram       `Program'
  , withForeignPtr'* `ForeignPtr Word8'
  }
  -> `Status' cToEnum #}
  where
    withForeignPtr' p f = withForeignPtr (castForeignPtr p) f

{-# INLINE nvvmGetProgramLogSize #-}
{# fun unsafe nvvmGetProgramLogSize
  { useProgram  `Program'
  , alloca-     `Int'     peekIntConv*
  }
  -> `Status' cToEnum #}

-- | Verify the NVVM program. If an error is encountered, an exception is
-- thrown.
--
verifyProgram :: Program -> [VerifyFlag] -> IO ()
verifyProgram prg opts =
  bracket
    (mapM (newCString . verifyFlagToArg) opts)
    (mapM free)
    (\args -> nothingIfOk =<< withArrayLen args (nvvmVerifyProgram prg))

{# fun unsafe nvvmVerifyProgram
  { useProgram `Program'
  , cIntConv   `Int'
  , id         `Ptr CString'
  }
  -> `Status' cToEnum #}


Fix documenation to Editable.

Fix documenation to Editable.

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Interface Editable
--
--  Author : Axel Simon, Duncan Coutts
--
--  Created: 30 July 2004
--
--  Copyright (C) 1999-2005 Axel Simon, Duncan Coutts
--
--  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)
--
-- Interface for text-editing widgets
--
module Graphics.UI.Gtk.Entry.Editable (
-- * Detail
--
-- | The 'Editable' interface is an interface which should be implemented by
-- text editing widgets, such as 'Entry'.
-- It contains functions for generically manipulating an editable
-- widget, a large number of action signals used for key bindings, and several
-- signals that an application can connect to to modify the behavior of a
-- widget.
--

-- * Class Hierarchy
-- |
-- @
-- |  GInterface
-- |   +----Editable
-- @

-- * Types
  Editable,
  EditableClass,
  castToEditable, gTypeEditable,
  toEditable,

-- * Methods
  editableSelectRegion,
  editableGetSelectionBounds,
  editableInsertText,
  editableDeleteText,
  editableGetChars,
  editableCutClipboard,
  editableCopyClipboard,
  editablePasteClipboard,
  editableDeleteSelection,
  editableSetEditable,
  editableGetEditable,
  editableSetPosition,
  editableGetPosition,

-- * Attributes
  editablePosition,
  editableEditable,

-- * Signals
  onEditableChanged,
  afterEditableChanged,
  onDeleteText,
  afterDeleteText,
  stopDeleteText,
  onInsertText,
  afterInsertText,
  stopInsertText
  ) where

import Control.Monad    (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

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

-- | Selects a region of text. The characters that are selected are those
-- characters at positions from @startPos@ up to, but not including @endPos@.
-- If @endPos@ is negative, then the the characters selected will be those
-- characters from @startPos@ to the end of the text.
--
-- Calling this function with @start@=1 and @end@=4 it will mark \"ask\" in
-- the string \"Haskell\".
--
editableSelectRegion :: EditableClass self => self
 -> Int   -- ^ @start@ - the starting position.
 -> Int   -- ^ @end@ - the end position.
 -> IO ()
editableSelectRegion self start end =
  {# call editable_select_region #}
    (toEditable self)
    (fromIntegral start)
    (fromIntegral end)

-- | Gets the current selection bounds, if there is a selection.
--
editableGetSelectionBounds :: EditableClass self => self
 -> IO (Int,Int) -- ^ @(start, end)@ - the starting and end positions. This
                 -- pair is not ordered. The @end@ index represents the
                 -- position of the cursor. The @start@ index is the other end
                 -- of the selection. If both numbers are equal there is in
                 -- fact no selection.
editableGetSelectionBounds self =
  alloca $ \startPtr ->
  alloca $ \endPtr -> do
  {# call unsafe editable_get_selection_bounds #}
    (toEditable self)
    startPtr
    endPtr
  start <- liftM fromIntegral $ peek startPtr
  end   <- liftM fromIntegral $ peek endPtr
  return (start,end)

-- | Inserts text at a given position.
--
editableInsertText :: EditableClass self => self
 -> String -- ^ @newText@ - the text to insert.
 -> Int    -- ^ @position@ - the position at which to insert the text.
 -> IO Int -- ^ returns the position after the newly inserted text.
editableInsertText self newText position =
  with (fromIntegral position) $ \positionPtr ->
  withUTFStringLen newText $ \(newTextPtr, newTextLength) -> do
  {# call editable_insert_text #}
    (toEditable self)
    newTextPtr
    (fromIntegral newTextLength)
    positionPtr
  position <- peek positionPtr
  return (fromIntegral position)

-- | Deletes a sequence of characters. The characters that are deleted are
-- those characters at positions from @startPos@ up to, but not including
-- @endPos@. If @endPos@ is negative, then the the characters deleted will be
-- those characters from @startPos@ to the end of the text.
--
editableDeleteText :: EditableClass self => self
 -> Int   -- ^ @startPos@ - the starting position.
 -> Int   -- ^ @endPos@ - the end position.
 -> IO ()
editableDeleteText self startPos endPos =
  {# call editable_delete_text #}
    (toEditable self)
    (fromIntegral startPos)
    (fromIntegral endPos)

-- | Retrieves a sequence of characters. The characters that are retrieved are
-- those characters at positions from @startPos@ up to, but not including
-- @endPos@. If @endPos@ is negative, then the the characters retrieved will be
-- those characters from @startPos@ to the end of the text.
--
editableGetChars :: EditableClass self => self
 -> Int       -- ^ @startPos@ - the starting position.
 -> Int       -- ^ @endPos@ - the end position.
 -> IO String -- ^ returns the characters in the indicated region.
editableGetChars self startPos endPos =
  {# call unsafe editable_get_chars #}
    (toEditable self)
    (fromIntegral startPos)
    (fromIntegral endPos)
  >>= readUTFString

-- | Causes the characters in the current selection to be copied to the
-- clipboard and then deleted from the widget.
--
editableCutClipboard :: EditableClass self => self -> IO ()
editableCutClipboard self =
  {# call editable_cut_clipboard #}
    (toEditable self)

-- | Causes the characters in the current selection to be copied to the
-- clipboard.
--
editableCopyClipboard :: EditableClass self => self -> IO ()
editableCopyClipboard self =
  {# call editable_copy_clipboard #}
    (toEditable self)

-- | Causes the contents of the clipboard to be pasted into the given widget
-- at the current cursor position.
--
editablePasteClipboard :: EditableClass self => self -> IO ()
editablePasteClipboard self =
  {# call editable_paste_clipboard #}
    (toEditable self)

-- | Deletes the current contents of the widgets selection and disclaims the
-- selection.
--
editableDeleteSelection :: EditableClass self => self -> IO ()
editableDeleteSelection self =
  {# call editable_delete_selection #}
    (toEditable self)

-- | Sets the cursor position.
--
editableSetPosition :: EditableClass self => self
 -> Int   -- ^ @position@ - the position of the cursor. The cursor is
          -- displayed before the character with the given (base 0) index in
          -- the widget. The value must be less than or equal to the number of
          -- characters in the widget. A value of -1 indicates that the
          -- position should be set after the last character in the entry.
 -> IO ()
editableSetPosition self position =
  {# call editable_set_position #}
    (toEditable self)
    (fromIntegral position)

-- | Retrieves the current cursor position.
--
editableGetPosition :: EditableClass self => self
 -> IO Int -- ^ returns the position of the cursor. The cursor is displayed
           -- before the character with the given (base 0) index in the widget.
           -- The value will be less than or equal to the number of characters
           -- in the widget. Note that this position is in characters, not in
           -- bytes.
editableGetPosition self =
  liftM fromIntegral $
  {# call unsafe editable_get_position #}
    (toEditable self)

-- | Determines if the user can edit the text in the editable widget or not.
--
editableSetEditable :: EditableClass self => self
 -> Bool  -- ^ @isEditable@ - @True@ if the user is allowed to edit the text
          -- in the widget.
 -> IO ()
editableSetEditable self isEditable =
  {# call editable_set_editable #}
    (toEditable self)
    (fromBool isEditable)

-- | Retrieves whether the text is editable. See 'editableSetEditable'.
--
editableGetEditable :: EditableClass self => self -> IO Bool
editableGetEditable self =
  liftM toBool $
  {# call editable_get_editable #}
    (toEditable self)

--------------------
-- Attributes

-- | \'position\' property. See 'editableGetPosition' and
-- 'editableSetPosition'
--
editablePosition :: EditableClass self => Attr self Int
editablePosition = newAttr
  editableGetPosition
  editableSetPosition

-- | \'editable\' property. See 'editableGetEditable' and
-- 'editableSetEditable'
--
editableEditable :: EditableClass self => Attr self Bool
editableEditable = newAttr
  editableGetEditable
  editableSetEditable

--------------------
-- Signals

-- | The 'onEditableChanged' signal is emitted at the end of a single
-- user-visible operation on the contents of the 'Editable'.
--
-- * For inctance, a paste operation that replaces the contents of the
--   selection will cause only one signal emission (even though it is
--   implemented by first deleting the selection, then inserting the new
--   content, and may cause multiple 'onEditableInserText' signals to be
--   emitted).
--
onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEditableChanged = connect_NONE__NONE "changed" False
afterEditableChanged = connect_NONE__NONE "changed" True

-- | Emitted when a piece of text is deleted from the 'Editable' widget.
--
-- * See 'onInsertText' for information on how to use this signal.
--
onDeleteText, afterDeleteText :: EditableClass self => self
 -> (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@
 -> IO (ConnectId self)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True

-- | Stop the current signal that deletes text.
stopDeleteText :: EditableClass self => ConnectId self -> IO ()
stopDeleteText (ConnectId _ obj) =
  signalStopEmission obj "delete_text"

-- | Emitted when a piece of text is inserted into the 'Editable' widget.
--
-- * The connected signal receives the text that is inserted, together with
--   the position in the entry widget. The return value should be the position
--   in the entry widget that lies past the recently inserted text (i.e.
--   you should return the given position plus the length of the string).
--
-- * To modify the text that the user inserts, you need to connect to this
--   signal, modify the text the way you want and then call
--   'editableInsertText'. To avoid that this signal handler is called
--   recursively, you need to temporarily block it using
--   'signalBlock'. After the default signal
--   handler has inserted your modified text, it is important that you
--   prevent the default handler from being executed again when this signal
--   handler returns. To stop the current signal, use 'stopInsertText'.
--   The following code is an example of how to turn all input into uppercase:
--
--   > idRef <- newIORef undefined
--   > id <- onInsertText entry $ \str pos -> do
--   >   id <- readIORef idRef
--   >   signalBlock id
--   >   pos' <- editableInsertText entry (map toUpper str) pos
--   >   signalUnblock id
--   >   stopInsertText id
--   >   return pos'
--   > writeIORef idRef id
--
--   Note that the 'afterInsertText' function is not very useful, except to
--   track editing actions.
--
onInsertText, afterInsertText :: EditableClass self => self
 -> (String -> Int -> IO Int)
 -> IO (ConnectId self)
onInsertText obj handler =
  connect_PTR_INT_PTR__NONE "insert_text" False obj
  (\strPtr strLen posPtr -> do
    str <- if strLen<0 then peekUTFString strPtr
           else peekUTFStringLen (strPtr, strLen)
    pos <- peek (posPtr :: Ptr {#type gint#})
    pos' <- handler str (fromIntegral pos)
    poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos')
  )
afterInsertText obj handler =
  connect_PTR_INT_PTR__NONE "insert_text" True obj
  (\strPtr strLen posPtr -> do
    str <- if strLen<0 then peekUTFString strPtr
           else peekUTFStringLen (strPtr, strLen)
    pos <- peek (posPtr :: Ptr {#type gint#})
    pos' <- handler str (fromIntegral pos)
    poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos')
  )

-- | Stop the current signal that inserts text.
stopInsertText :: EditableClass self => ConnectId self -> IO ()
stopInsertText (ConnectId _ obj) =
  signalStopEmission obj "insert_text"

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Interface Editable
--
--  Author : Axel Simon, Duncan Coutts
--
--  Created: 30 July 2004
--
--  Copyright (C) 1999-2005 Axel Simon, Duncan Coutts
--
--  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)
--
-- Interface for text-editing widgets
--
module Graphics.UI.Gtk.Entry.Editable (
-- * Detail
--
-- | The 'Editable' interface is an interface which should be implemented by
-- text editing widgets, such as 'Entry'.
-- It contains functions for generically manipulating an editable
-- widget, a large number of action signals used for key bindings, and several
-- signals that an application can connect to to modify the behavior of a
-- widget.
--

-- * Class Hierarchy
-- |
-- @
-- |  GInterface
-- |   +----Editable
-- @

-- * Types
  Editable,
  EditableClass,
  castToEditable, gTypeEditable,
  toEditable,

-- * Methods
  editableSelectRegion,
  editableGetSelectionBounds,
  editableInsertText,
  editableDeleteText,
  editableGetChars,
  editableCutClipboard,
  editableCopyClipboard,
  editablePasteClipboard,
  editableDeleteSelection,
  editableSetEditable,
  editableGetEditable,
  editableSetPosition,
  editableGetPosition,

-- * Attributes
  editablePosition,
  editableEditable,

-- * Signals
  onEditableChanged,
  afterEditableChanged,
  onDeleteText,
  afterDeleteText,
  stopDeleteText,
  onInsertText,
  afterInsertText,
  stopInsertText
  ) where

import Control.Monad    (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}

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

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

-- | Selects a region of text. The characters that are selected are those
-- characters at positions from @startPos@ up to, but not including @endPos@.
-- If @endPos@ is negative, then the the characters selected will be those
-- characters from @startPos@ to the end of the text.
--
-- Calling this function with @start@=1 and @end@=4 it will mark \"ask\" in
-- the string \"Haskell\".
--
editableSelectRegion :: EditableClass self => self
 -> Int   -- ^ @start@ - the starting position.
 -> Int   -- ^ @end@ - the end position.
 -> IO ()
editableSelectRegion self start end =
  {# call editable_select_region #}
    (toEditable self)
    (fromIntegral start)
    (fromIntegral end)

-- | Gets the current selection bounds, if there is a selection.
--
editableGetSelectionBounds :: EditableClass self => self
 -> IO (Int,Int) -- ^ @(start, end)@ - the starting and end positions. This
                 -- pair is not ordered. The @end@ index represents the
                 -- position of the cursor. The @start@ index is the other end
                 -- of the selection. If both numbers are equal there is in
                 -- fact no selection.
editableGetSelectionBounds self =
  alloca $ \startPtr ->
  alloca $ \endPtr -> do
  {# call unsafe editable_get_selection_bounds #}
    (toEditable self)
    startPtr
    endPtr
  start <- liftM fromIntegral $ peek startPtr
  end   <- liftM fromIntegral $ peek endPtr
  return (start,end)

-- | Inserts text at a given position.
--
editableInsertText :: EditableClass self => self
 -> String -- ^ @newText@ - the text to insert.
 -> Int    -- ^ @position@ - the position at which to insert the text.
 -> IO Int -- ^ returns the position after the newly inserted text.
editableInsertText self newText position =
  with (fromIntegral position) $ \positionPtr ->
  withUTFStringLen newText $ \(newTextPtr, newTextLength) -> do
  {# call editable_insert_text #}
    (toEditable self)
    newTextPtr
    (fromIntegral newTextLength)
    positionPtr
  position <- peek positionPtr
  return (fromIntegral position)

-- | Deletes a sequence of characters. The characters that are deleted are
-- those characters at positions from @startPos@ up to, but not including
-- @endPos@. If @endPos@ is negative, then the the characters deleted will be
-- those characters from @startPos@ to the end of the text.
--
editableDeleteText :: EditableClass self => self
 -> Int   -- ^ @startPos@ - the starting position.
 -> Int   -- ^ @endPos@ - the end position.
 -> IO ()
editableDeleteText self startPos endPos =
  {# call editable_delete_text #}
    (toEditable self)
    (fromIntegral startPos)
    (fromIntegral endPos)

-- | Retrieves a sequence of characters. The characters that are retrieved are
-- those characters at positions from @startPos@ up to, but not including
-- @endPos@. If @endPos@ is negative, then the the characters retrieved will be
-- those characters from @startPos@ to the end of the text.
--
editableGetChars :: EditableClass self => self
 -> Int       -- ^ @startPos@ - the starting position.
 -> Int       -- ^ @endPos@ - the end position.
 -> IO String -- ^ returns the characters in the indicated region.
editableGetChars self startPos endPos =
  {# call unsafe editable_get_chars #}
    (toEditable self)
    (fromIntegral startPos)
    (fromIntegral endPos)
  >>= readUTFString

-- | Causes the characters in the current selection to be copied to the
-- clipboard and then deleted from the widget.
--
editableCutClipboard :: EditableClass self => self -> IO ()
editableCutClipboard self =
  {# call editable_cut_clipboard #}
    (toEditable self)

-- | Causes the characters in the current selection to be copied to the
-- clipboard.
--
editableCopyClipboard :: EditableClass self => self -> IO ()
editableCopyClipboard self =
  {# call editable_copy_clipboard #}
    (toEditable self)

-- | Causes the contents of the clipboard to be pasted into the given widget
-- at the current cursor position.
--
editablePasteClipboard :: EditableClass self => self -> IO ()
editablePasteClipboard self =
  {# call editable_paste_clipboard #}
    (toEditable self)

-- | Deletes the current contents of the widgets selection and disclaims the
-- selection.
--
editableDeleteSelection :: EditableClass self => self -> IO ()
editableDeleteSelection self =
  {# call editable_delete_selection #}
    (toEditable self)

-- | Sets the cursor position.
--
editableSetPosition :: EditableClass self => self
 -> Int   -- ^ @position@ - the position of the cursor. The cursor is
          -- displayed before the character with the given (base 0) index in
          -- the widget. The value must be less than or equal to the number of
          -- characters in the widget. A value of -1 indicates that the
          -- position should be set after the last character in the entry.
 -> IO ()
editableSetPosition self position =
  {# call editable_set_position #}
    (toEditable self)
    (fromIntegral position)

-- | Retrieves the current cursor position.
--
editableGetPosition :: EditableClass self => self
 -> IO Int -- ^ returns the position of the cursor. The cursor is displayed
           -- before the character with the given (base 0) index in the widget.
           -- The value will be less than or equal to the number of characters
           -- in the widget. Note that this position is in characters, not in
           -- bytes.
editableGetPosition self =
  liftM fromIntegral $
  {# call unsafe editable_get_position #}
    (toEditable self)

-- | Determines if the user can edit the text in the editable widget or not.
--
editableSetEditable :: EditableClass self => self
 -> Bool  -- ^ @isEditable@ - @True@ if the user is allowed to edit the text
          -- in the widget.
 -> IO ()
editableSetEditable self isEditable =
  {# call editable_set_editable #}
    (toEditable self)
    (fromBool isEditable)

-- | Retrieves whether the text is editable. See 'editableSetEditable'.
--
editableGetEditable :: EditableClass self => self -> IO Bool
editableGetEditable self =
  liftM toBool $
  {# call editable_get_editable #}
    (toEditable self)

--------------------
-- Attributes

-- | \'position\' property. See 'editableGetPosition' and
-- 'editableSetPosition'
--
editablePosition :: EditableClass self => Attr self Int
editablePosition = newAttr
  editableGetPosition
  editableSetPosition

-- | \'editable\' property. See 'editableGetEditable' and
-- 'editableSetEditable'
--
editableEditable :: EditableClass self => Attr self Bool
editableEditable = newAttr
  editableGetEditable
  editableSetEditable

--------------------
-- Signals

-- | Emitted when the settings of the 'Editable' widget changes.
--
onEditableChanged, afterEditableChanged :: EditableClass ec => ec -> IO () ->
                                     IO (ConnectId ec)
onEditableChanged = connect_NONE__NONE "changed" False
afterEditableChanged = connect_NONE__NONE "changed" True

-- | Emitted when a piece of text is deleted from the 'Editable' widget.
--
-- * See 'onInsertText' for information on how to use this signal.
--
onDeleteText, afterDeleteText :: EditableClass self => self
 -> (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@
 -> IO (ConnectId self)
onDeleteText = connect_INT_INT__NONE "delete_text" False
afterDeleteText = connect_INT_INT__NONE "delete_text" True

-- | Stop the current signal that deletes text.
stopDeleteText :: EditableClass self => ConnectId self -> IO ()
stopDeleteText (ConnectId _ obj) =
  signalStopEmission obj "delete_text"

-- | Emitted when a piece of text is inserted into the 'Editable' widget.
--
-- * The connected signal receives the text that is inserted, together with
--   the position in the entry widget. The return value should be the position
--   in the entry widget that lies past the recently inserted text (i.e.
--   you should return the given position plus the length of the string).
--
-- * To modify the text that the user inserts, you need to connect to this
--   signal, modify the text the way you want and then call
--   'editableInsertText'. To avoid that this signal handler is called
--   recursively, you need to temporarily block it using
--   'signalBlock'. After the default signal
--   handler has inserted your modified text, it is important that you
--   prevent the default handler from being executed again when this signal
--   handler returns. To stop the current signal, use 'stopInsertText'.
--   The following code is an example of how to turn all input into uppercase:
--
--   > idRef <- newIORef undefined
--   > id <- onInsertText entry $ \str pos -> do
--   >   id <- readIORef idRef
--   >   signalBlock id
--   >   pos' <- editableInsertText entry (map toUpper str) pos
--   >   signalUnblock id
--   >   stopInsertText id
--   >   return pos'
--   > writeIORef idRef id
--
--   Note that the 'afterInsertText' function is not very useful, except to
--   track editing actions.
--
onInsertText, afterInsertText :: EditableClass self => self
 -> (String -> Int -> IO Int)
 -> IO (ConnectId self)
onInsertText obj handler =
  connect_PTR_INT_PTR__NONE "insert_text" False obj
  (\strPtr strLen posPtr -> do
    str <- if strLen<0 then peekUTFString strPtr
           else peekUTFStringLen (strPtr, strLen)
    pos <- peek (posPtr :: Ptr {#type gint#})
    pos' <- handler str (fromIntegral pos)
    poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos')
  )
afterInsertText obj handler =
  connect_PTR_INT_PTR__NONE "insert_text" True obj
  (\strPtr strLen posPtr -> do
    str <- if strLen<0 then peekUTFString strPtr
           else peekUTFStringLen (strPtr, strLen)
    pos <- peek (posPtr :: Ptr {#type gint#})
    pos' <- handler str (fromIntegral pos)
    poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos')
  )

-- | Stop the current signal that inserts text.
stopInsertText :: EditableClass self => ConnectId self -> IO ()
stopInsertText (ConnectId _ obj) =
  signalStopEmission obj "insert_text"


Use 'SourceUndoManagerClass sum => sum' replace SourceUndoManager as function argument.

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) SourceUndoManager
--
--  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.SourceUndoManager (
-- * Description
-- | The 'SourceUndoManager' interface can be implemented to provide custom undo management to a
-- 'SourceBuffer'. Use 'sourceBufferSetUndoManager' to install a custom undo manager for a
-- particular source buffer.
--
-- Use 'sourceUndoManagerCanUndoChanged' and 'sourceUndoManagerCanRedoChanged' when
-- respectively the undo state or redo state of the undo stack has changed.

-- * Types
    SourceUndoManager,
    SourceUndoManagerClass,

-- * Methods
    sourceUndoManagerCanUndo,
    sourceUndoManagerCanRedo,
    sourceUndoManagerUndo,
    sourceUndoManagerRedo,
    sourceUndoManagerBeginNotUndoableAction,
    sourceUndoManagerEndNotUndoableAction,

-- * Signals
    sourceUndoManagerCanRedoChanged,
    sourceUndoManagerCanUndoChanged,
) where

import Control.Monad	(liftM)

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

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

-- | Get whether there are undo operations available.
sourceUndoManagerCanUndo :: SourceUndoManagerClass sum => sum
                         -> IO Bool  -- ^ returns 'True' if there are undo operations available, 'False' otherwise
sourceUndoManagerCanUndo sm =
  liftM toBool $
  {#call gtk_source_undo_manager_can_undo #} (toSourceUndoManager sm)

-- | Get whether there are redo operations available.
sourceUndoManagerCanRedo :: SourceUndoManagerClass sum => sum
                         -> IO Bool  -- ^ returns 'True' if there are redo operations available, 'False' otherwise
sourceUndoManagerCanRedo sm =
  liftM toBool $
  {#call gtk_source_undo_manager_can_redo #} (toSourceUndoManager sm)

-- | Perform a single undo. Calling this function when there are no undo operations available is an
-- error. Use @gtkSourceUndoManagerCanUndo@ to find out if there are undo operations available.
sourceUndoManagerUndo :: SourceUndoManagerClass sum => sum -> IO ()
sourceUndoManagerUndo sm =
  {#call gtk_source_undo_manager_undo #} (toSourceUndoManager sm)

-- | Perform a single redo. Calling this function when there are no redo operations available is an
-- error. Use @gtkSourceUndoManagerCanRedo@ to find out if there are redo operations available.
sourceUndoManagerRedo :: SourceUndoManagerClass sum => sum -> IO ()
sourceUndoManagerRedo sm =
  {#call gtk_source_undo_manager_redo #} (toSourceUndoManager sm)

-- | Begin a not undoable action on the buffer. All changes between this call and the call to
-- @gtkSourceUndoManagerEndNotUndoableAction@ cannot be undone. This function should be
-- re-entrant.
sourceUndoManagerBeginNotUndoableAction :: SourceUndoManagerClass sum => sum -> IO ()
sourceUndoManagerBeginNotUndoableAction sm =
  {#call gtk_source_undo_manager_begin_not_undoable_action #} (toSourceUndoManager sm)

-- | Ends a not undoable action on the buffer.
sourceUndoManagerEndNotUndoableAction :: SourceUndoManagerClass sum => sum -> IO ()
sourceUndoManagerEndNotUndoableAction sm =
  {#call gtk_source_undo_manager_end_not_undoable_action #} (toSourceUndoManager sm)

-- | Emitted when the ability to redo has changed.
--
sourceUndoManagerCanRedoChanged :: SourceUndoManagerClass sum => Signal sum (IO ())
sourceUndoManagerCanRedoChanged = Signal $ connect_NONE__NONE "can-redo-changed"

-- | Emitted when the ability to undo has changed.
--
sourceUndoManagerCanUndoChanged :: SourceUndoManagerClass sum => Signal sum (IO ())
sourceUndoManagerCanUndoChanged = Signal $ connect_NONE__NONE "can-undo-changed"

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) SourceUndoManager
--
--  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.SourceUndoManager (
-- * Description
-- | The 'SourceUndoManager' interface can be implemented to provide custom undo management to a
-- 'SourceBuffer'. Use 'sourceBufferSetUndoManager' to install a custom undo manager for a
-- particular source buffer.
--
-- Use 'sourceUndoManagerCanUndoChanged' and 'sourceUndoManagerCanRedoChanged' when
-- respectively the undo state or redo state of the undo stack has changed.

-- * Types
    SourceUndoManager,

-- * Methods
    sourceUndoManagerCanUndo,
    sourceUndoManagerCanRedo,
    sourceUndoManagerUndo,
    sourceUndoManagerRedo,
    sourceUndoManagerBeginNotUndoableAction,
    sourceUndoManagerEndNotUndoableAction,

-- * Signals
    sourceUndoManagerCanRedoChanged,
    sourceUndoManagerCanUndoChanged,
) where

import Control.Monad	(liftM)

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

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

-- | Get whether there are undo operations available.
sourceUndoManagerCanUndo :: SourceUndoManager
                         -> IO Bool  -- ^ returns 'True' if there are undo operations available, 'False' otherwise
sourceUndoManagerCanUndo sm =
  liftM toBool $
  {#call gtk_source_undo_manager_can_undo #} sm

-- | Get whether there are redo operations available.
sourceUndoManagerCanRedo :: SourceUndoManager
                         -> IO Bool  -- ^ returns 'True' if there are redo operations available, 'False' otherwise
sourceUndoManagerCanRedo sm =
  liftM toBool $
  {#call gtk_source_undo_manager_can_redo #} sm

-- | Perform a single undo. Calling this function when there are no undo operations available is an
-- error. Use @gtkSourceUndoManagerCanUndo@ to find out if there are undo operations available.
sourceUndoManagerUndo :: SourceUndoManager -> IO ()
sourceUndoManagerUndo sm =
  {#call gtk_source_undo_manager_undo #} sm

-- | Perform a single redo. Calling this function when there are no redo operations available is an
-- error. Use @gtkSourceUndoManagerCanRedo@ to find out if there are redo operations available.
sourceUndoManagerRedo :: SourceUndoManager -> IO ()
sourceUndoManagerRedo sm =
  {#call gtk_source_undo_manager_redo #} sm

-- | Begin a not undoable action on the buffer. All changes between this call and the call to
-- @gtkSourceUndoManagerEndNotUndoableAction@ cannot be undone. This function should be
-- re-entrant.
sourceUndoManagerBeginNotUndoableAction :: SourceUndoManager -> IO ()
sourceUndoManagerBeginNotUndoableAction sm =
  {#call gtk_source_undo_manager_begin_not_undoable_action #} sm

-- | Ends a not undoable action on the buffer.
sourceUndoManagerEndNotUndoableAction :: SourceUndoManager -> IO ()
sourceUndoManagerEndNotUndoableAction sm =
  {#call gtk_source_undo_manager_end_not_undoable_action #} sm

-- | Emitted when the ability to redo has changed.
--
sourceUndoManagerCanRedoChanged :: Signal SourceUndoManager (IO ())
sourceUndoManagerCanRedoChanged = Signal $ connect_NONE__NONE "can-redo-changed"

-- | Emitted when the ability to undo has changed.
--
sourceUndoManagerCanUndoChanged :: Signal SourceUndoManager (IO ())
sourceUndoManagerCanUndoChanged = Signal $ connect_NONE__NONE "can-undo-changed"


use withArrayLen to avoid a second list traversal

{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Module.Base
-- Copyright : [2009..2014] Trevor L. McDonell
-- License   : BSD
--
-- Module loading for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Module.Base (

  -- * Module Management
  Module(..),
  JITOption(..), JITTarget(..), JITResult(..), JITFallback(..),

  -- ** Loading and unloading modules
  loadFile,
  loadData,   loadDataFromPtr,
  loadDataEx, loadDataFromPtrEx,
  unload,

  -- Internal
  jitOptionUnpack, jitTargetOfCompute,

) where

#include "cbits/stubs.h"
{# context lib="cuda" #}

-- Friends
import Foreign.CUDA.Analysis.Device
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Foreign
import Foreign.C
import Unsafe.Coerce

import Control.Monad                                    ( liftM )
import Data.ByteString.Char8                            ( ByteString )
import qualified Data.ByteString.Char8                  as B
import qualified Data.ByteString.Internal               as B

--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

-- |
-- A reference to a Module object, containing collections of device functions
--
newtype Module = Module { useModule :: {# type CUmodule #}}
  deriving (Eq, Show)

-- |
-- Just-in-time compilation options
--
data JITOption
  = MaxRegisters       !Int             -- ^ maximum number of registers per thread
  | ThreadsPerBlock    !Int             -- ^ number of threads per block to target for
  | OptimisationLevel  !Int             -- ^ level of optimisation to apply (1-4, default 4)
  | Target             !Compute         -- ^ compilation target, otherwise determined from context
  | FallbackStrategy   !JITFallback     -- ^ fallback strategy if matching cubin not found
  | GenerateDebugInfo                   -- ^ generate debug info (-g) (requires cuda >= 5.5)
  | GenerateLineInfo                    -- ^ generate line number information (-lineinfo) (requires cuda >= 5.5)
  | Verbose                             -- ^ verbose log messages (requires cuda >= 5.5)
  deriving (Show)

-- |
-- Results of online compilation
--
data JITResult = JITResult
  {
    jitTime     :: !Float,              -- ^ milliseconds spent compiling PTX
    jitInfoLog  :: !ByteString,         -- ^ information about PTX assembly
    jitModule   :: !Module              -- ^ compilation error log or compiled module
  }
  deriving (Show)

{# enum CUjit_option as JITOptionInternal
    { }
    with prefix="CU" deriving (Eq, Show) #}

{# enum CUjit_target as JITTarget
    { underscoreToCase }
    with prefix="CU_TARGET" deriving (Eq, Show) #}

{# enum CUjit_fallback as JITFallback
    { underscoreToCase
    , CU_PREFER_PTX as PTX }
    with prefix="CU_PREFER" deriving (Eq, Show) #}

--------------------------------------------------------------------------------
-- Module management
--------------------------------------------------------------------------------

-- |
-- Load the contents of the specified file (either a ptx or cubin file) to
-- create a new module, and load that module into the current context.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g366093bd269dafd0af21f1c7d18115d3>
--
{-# INLINEABLE loadFile #-}
loadFile :: FilePath -> IO Module
loadFile !ptx = resultIfOk =<< cuModuleLoad ptx

{-# INLINE cuModuleLoad #-}
{# fun unsafe cuModuleLoad
  { alloca-      `Module'   peekMod*
  , withCString* `FilePath'          } -> `Status' cToEnum #}

-- |
-- Load the contents of the given image into a new module, and load that module
-- into the current context. The image is (typically) the contents of a cubin or
-- PTX file.
--
-- Note that the 'ByteString' will be copied into a temporary staging area so
-- that it can be passed to C.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g04ce266ce03720f479eab76136b90c0b>
--
{-# INLINEABLE loadData #-}
loadData :: ByteString -> IO Module
loadData !img =
  B.useAsCString img (\p -> loadDataFromPtr (castPtr p))

-- |
-- As 'loadData', but read the image data from the given pointer. The image is a
-- NULL-terminated sequence of bytes.
--
{-# INLINEABLE loadDataFromPtr #-}
loadDataFromPtr :: Ptr Word8 -> IO Module
loadDataFromPtr !img = resultIfOk =<< cuModuleLoadData img

{-# INLINE cuModuleLoadData #-}
{# fun unsafe cuModuleLoadData
  { alloca- `Module'    peekMod*
  , castPtr `Ptr Word8'          } -> ` Status' cToEnum #}

-- |
-- Load the contents of the given image into a module with online compiler
-- options, and load the module into the current context. The image is
-- (typically) the contents of a cubin or PTX file. The actual attributes of the
-- compiled kernel can be probed using 'requires'.
--
-- Note that the 'ByteString' will be copied into a temporary staging area so
-- that it can be passed to C.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9e8047e9dbf725f0cd7cafd18bfd4d12>
--
{-# INLINEABLE loadDataEx #-}
loadDataEx :: ByteString -> [JITOption] -> IO JITResult
loadDataEx !img !options =
  B.useAsCString img (\p -> loadDataFromPtrEx (castPtr p) options)

-- |
-- As 'loadDataEx', but read the image data from the given pointer. The image is
-- a NULL-terminated sequence of bytes.
--
{-# INLINEABLE loadDataFromPtrEx #-}
loadDataFromPtrEx :: Ptr Word8 -> [JITOption] -> IO JITResult
loadDataFromPtrEx !img !options = do
  let logSize = 2048

  fp_ilog <- B.mallocByteString logSize

  allocaArray logSize    $ \p_elog -> do
  withForeignPtr fp_ilog $ \p_ilog -> do

  let (opt,val) = unzip $
        [ (JIT_WALL_TIME, 0) -- must be first, this is extracted below
        , (JIT_INFO_LOG_BUFFER_SIZE_BYTES,  logSize)
        , (JIT_ERROR_LOG_BUFFER_SIZE_BYTES, logSize)
        , (JIT_INFO_LOG_BUFFER,  unsafeCoerce (p_ilog :: CString))
        , (JIT_ERROR_LOG_BUFFER, unsafeCoerce (p_elog :: CString))
        ]
        ++
        map jitOptionUnpack options

  withArrayLen (map cFromEnum opt)    $ \i p_opts -> do
  withArray    (map unsafeCoerce val) $ \  p_vals -> do

  (s,mdl) <- cuModuleLoadDataEx img i p_opts p_vals

  case s of
    Success     -> do
      time    <- peek (castPtr p_vals)
      infoLog <- B.fromForeignPtr (castForeignPtr fp_ilog) 0 `fmap` c_strnlen p_ilog logSize
      return  $! JITResult time infoLog mdl

    _           -> do
      errLog  <- peekCString p_elog
      cudaError (unlines [describe s, errLog])

{-# INLINE cuModuleLoadDataEx #-}
{# fun unsafe cuModuleLoadDataEx
  { alloca- `Module'       peekMod*
  , castPtr `Ptr Word8'
  ,         `Int'
  , id      `Ptr CInt'
  , id      `Ptr (Ptr ())'          } -> `Status' cToEnum #}

-- |
-- Unload a module from the current context.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g8ea3d716524369de3763104ced4ea57b>
--
{-# INLINEABLE unload #-}
unload :: Module -> IO ()
unload !m = nothingIfOk =<< cuModuleUnload m

{-# INLINE cuModuleUnload #-}
{# fun unsafe cuModuleUnload
  { useModule `Module' } -> `Status' cToEnum #}

--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

{-# INLINE peekMod #-}
peekMod :: Ptr {# type CUmodule #} -> IO Module
peekMod = liftM Module . peek

{-# INLINE jitOptionUnpack #-}
jitOptionUnpack :: JITOption -> (JITOptionInternal, Int)
jitOptionUnpack (MaxRegisters x)      = (JIT_MAX_REGISTERS,       x)
jitOptionUnpack (ThreadsPerBlock x)   = (JIT_THREADS_PER_BLOCK,   x)
jitOptionUnpack (OptimisationLevel x) = (JIT_OPTIMIZATION_LEVEL,  x)
jitOptionUnpack (Target x)            = (JIT_TARGET,              fromEnum (jitTargetOfCompute x))
jitOptionUnpack (FallbackStrategy x)  = (JIT_FALLBACK_STRATEGY,   fromEnum x)
#if CUDA_VERSION >= 5050
jitOptionUnpack GenerateDebugInfo     = (JIT_GENERATE_DEBUG_INFO, fromEnum True)
jitOptionUnpack GenerateLineInfo      = (JIT_GENERATE_LINE_INFO,  fromEnum True)
jitOptionUnpack Verbose               = (JIT_LOG_VERBOSE,         fromEnum True)
#else
jitOptionUnpack GenerateDebugInfo     = requireSDK 'GenerateDebugInfo 5.5
jitOptionUnpack GenerateLineInfo      = requireSDK 'GenerateLineInfo 5.5
jitOptionUnpack Verbose               = requireSDK 'Verbose 5.5
#endif

{-# INLINE jitTargetOfCompute #-}
jitTargetOfCompute :: Compute -> JITTarget
jitTargetOfCompute (Compute 1 0) = Compute10
jitTargetOfCompute (Compute 1 1) = Compute11
jitTargetOfCompute (Compute 1 2) = Compute12
jitTargetOfCompute (Compute 1 3) = Compute13
jitTargetOfCompute (Compute 2 0) = Compute20
jitTargetOfCompute (Compute 2 1) = Compute21
jitTargetOfCompute (Compute 3 0) = Compute30
jitTargetOfCompute (Compute 3 5) = Compute35
#if CUDA_VERSION >= 6000
jitTargetOfCompute (Compute 3 2) = Compute32
jitTargetOfCompute (Compute 5 0) = Compute50
#endif
#if CUDA_VERSION >= 6050
jitTargetOfCompute (Compute 3 7) = Compute37
#endif
#if CUDA_VERSION >= 7000
jitTargetOfCompute (Compute 5 2) = Compute52
#endif
jitTargetOfCompute compute       = error ("Unknown JIT Target for Compute " ++ show compute)

{-# INLINE c_strnlen' #-}
#if defined(WIN32)
c_strnlen' :: CString -> CSize -> IO CSize
c_strnlen' str size = do
  str' <- peekCStringLen (str, fromIntegral size)
  return $ stringLen 0 str'
  where
    stringLen acc []       = acc
    stringLen acc ('\0':_) = acc
    stringLen acc (_:xs)   = stringLen (acc+1) xs
#else
foreign import ccall unsafe "string.h strnlen" c_strnlen'
  :: CString -> CSize -> IO CSize
#endif

{-# INLINE c_strnlen #-}
c_strnlen :: CString -> Int -> IO Int
c_strnlen str maxlen = cIntConv `fmap` c_strnlen' str (cIntConv maxlen)

{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Module.Base
-- Copyright : [2009..2014] Trevor L. McDonell
-- License   : BSD
--
-- Module loading for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Module.Base (

  -- * Module Management
  Module(..),
  JITOption(..), JITTarget(..), JITResult(..), JITFallback(..),

  -- ** Loading and unloading modules
  loadFile,
  loadData,   loadDataFromPtr,
  loadDataEx, loadDataFromPtrEx,
  unload,

  -- Internal
  jitOptionUnpack, jitTargetOfCompute,

) where

#include "cbits/stubs.h"
{# context lib="cuda" #}

-- Friends
import Foreign.CUDA.Analysis.Device
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Foreign
import Foreign.C
import Unsafe.Coerce

import Control.Monad                                    ( liftM )
import Data.ByteString.Char8                            ( ByteString )
import qualified Data.ByteString.Char8                  as B
import qualified Data.ByteString.Internal               as B

--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

-- |
-- A reference to a Module object, containing collections of device functions
--
newtype Module = Module { useModule :: {# type CUmodule #}}
  deriving (Eq, Show)

-- |
-- Just-in-time compilation options
--
data JITOption
  = MaxRegisters       !Int             -- ^ maximum number of registers per thread
  | ThreadsPerBlock    !Int             -- ^ number of threads per block to target for
  | OptimisationLevel  !Int             -- ^ level of optimisation to apply (1-4, default 4)
  | Target             !Compute         -- ^ compilation target, otherwise determined from context
  | FallbackStrategy   !JITFallback     -- ^ fallback strategy if matching cubin not found
  | GenerateDebugInfo                   -- ^ generate debug info (-g) (requires cuda >= 5.5)
  | GenerateLineInfo                    -- ^ generate line number information (-lineinfo) (requires cuda >= 5.5)
  | Verbose                             -- ^ verbose log messages (requires cuda >= 5.5)
  deriving (Show)

-- |
-- Results of online compilation
--
data JITResult = JITResult
  {
    jitTime     :: !Float,              -- ^ milliseconds spent compiling PTX
    jitInfoLog  :: !ByteString,         -- ^ information about PTX assembly
    jitModule   :: !Module              -- ^ compilation error log or compiled module
  }
  deriving (Show)

{# enum CUjit_option as JITOptionInternal
    { }
    with prefix="CU" deriving (Eq, Show) #}

{# enum CUjit_target as JITTarget
    { underscoreToCase }
    with prefix="CU_TARGET" deriving (Eq, Show) #}

{# enum CUjit_fallback as JITFallback
    { underscoreToCase
    , CU_PREFER_PTX as PTX }
    with prefix="CU_PREFER" deriving (Eq, Show) #}

--------------------------------------------------------------------------------
-- Module management
--------------------------------------------------------------------------------

-- |
-- Load the contents of the specified file (either a ptx or cubin file) to
-- create a new module, and load that module into the current context.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g366093bd269dafd0af21f1c7d18115d3>
--
{-# INLINEABLE loadFile #-}
loadFile :: FilePath -> IO Module
loadFile !ptx = resultIfOk =<< cuModuleLoad ptx

{-# INLINE cuModuleLoad #-}
{# fun unsafe cuModuleLoad
  { alloca-      `Module'   peekMod*
  , withCString* `FilePath'          } -> `Status' cToEnum #}

-- |
-- Load the contents of the given image into a new module, and load that module
-- into the current context. The image is (typically) the contents of a cubin or
-- PTX file.
--
-- Note that the 'ByteString' will be copied into a temporary staging area so
-- that it can be passed to C.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g04ce266ce03720f479eab76136b90c0b>
--
{-# INLINEABLE loadData #-}
loadData :: ByteString -> IO Module
loadData !img =
  B.useAsCString img (\p -> loadDataFromPtr (castPtr p))

-- |
-- As 'loadData', but read the image data from the given pointer. The image is a
-- NULL-terminated sequence of bytes.
--
{-# INLINEABLE loadDataFromPtr #-}
loadDataFromPtr :: Ptr Word8 -> IO Module
loadDataFromPtr !img = resultIfOk =<< cuModuleLoadData img

{-# INLINE cuModuleLoadData #-}
{# fun unsafe cuModuleLoadData
  { alloca- `Module'    peekMod*
  , castPtr `Ptr Word8'          } -> ` Status' cToEnum #}

-- |
-- Load the contents of the given image into a module with online compiler
-- options, and load the module into the current context. The image is
-- (typically) the contents of a cubin or PTX file. The actual attributes of the
-- compiled kernel can be probed using 'requires'.
--
-- Note that the 'ByteString' will be copied into a temporary staging area so
-- that it can be passed to C.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9e8047e9dbf725f0cd7cafd18bfd4d12>
--
{-# INLINEABLE loadDataEx #-}
loadDataEx :: ByteString -> [JITOption] -> IO JITResult
loadDataEx !img !options =
  B.useAsCString img (\p -> loadDataFromPtrEx (castPtr p) options)

-- |
-- As 'loadDataEx', but read the image data from the given pointer. The image is
-- a NULL-terminated sequence of bytes.
--
{-# INLINEABLE loadDataFromPtrEx #-}
loadDataFromPtrEx :: Ptr Word8 -> [JITOption] -> IO JITResult
loadDataFromPtrEx !img !options = do
  let logSize = 2048

  fp_ilog <- B.mallocByteString logSize

  allocaArray logSize    $ \p_elog -> do
  withForeignPtr fp_ilog $ \p_ilog -> do

  let (opt,val) = unzip $
        [ (JIT_WALL_TIME, 0) -- must be first, this is extracted below
        , (JIT_INFO_LOG_BUFFER_SIZE_BYTES,  logSize)
        , (JIT_ERROR_LOG_BUFFER_SIZE_BYTES, logSize)
        , (JIT_INFO_LOG_BUFFER,  unsafeCoerce (p_ilog :: CString))
        , (JIT_ERROR_LOG_BUFFER, unsafeCoerce (p_elog :: CString))
        ]
        ++
        map jitOptionUnpack options

  withArray (map cFromEnum opt)    $ \p_opts -> do
  withArray (map unsafeCoerce val) $ \p_vals -> do

  (s,mdl) <- cuModuleLoadDataEx img (length opt) p_opts p_vals

  case s of
    Success     -> do
      time    <- peek (castPtr p_vals)
      infoLog <- B.fromForeignPtr (castForeignPtr fp_ilog) 0 `fmap` c_strnlen p_ilog logSize
      return  $! JITResult time infoLog mdl

    _           -> do
      errLog  <- peekCString p_elog
      cudaError (unlines [describe s, errLog])

{-# INLINE cuModuleLoadDataEx #-}
{# fun unsafe cuModuleLoadDataEx
  { alloca- `Module'       peekMod*
  , castPtr `Ptr Word8'
  ,         `Int'
  , id      `Ptr CInt'
  , id      `Ptr (Ptr ())'          } -> `Status' cToEnum #}

-- |
-- Unload a module from the current context.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g8ea3d716524369de3763104ced4ea57b>
--
{-# INLINEABLE unload #-}
unload :: Module -> IO ()
unload !m = nothingIfOk =<< cuModuleUnload m

{-# INLINE cuModuleUnload #-}
{# fun unsafe cuModuleUnload
  { useModule `Module' } -> `Status' cToEnum #}

--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

{-# INLINE peekMod #-}
peekMod :: Ptr {# type CUmodule #} -> IO Module
peekMod = liftM Module . peek

{-# INLINE jitOptionUnpack #-}
jitOptionUnpack :: JITOption -> (JITOptionInternal, Int)
jitOptionUnpack (MaxRegisters x)      = (JIT_MAX_REGISTERS,       x)
jitOptionUnpack (ThreadsPerBlock x)   = (JIT_THREADS_PER_BLOCK,   x)
jitOptionUnpack (OptimisationLevel x) = (JIT_OPTIMIZATION_LEVEL,  x)
jitOptionUnpack (Target x)            = (JIT_TARGET,              fromEnum (jitTargetOfCompute x))
jitOptionUnpack (FallbackStrategy x)  = (JIT_FALLBACK_STRATEGY,   fromEnum x)
#if CUDA_VERSION >= 5050
jitOptionUnpack GenerateDebugInfo     = (JIT_GENERATE_DEBUG_INFO, fromEnum True)
jitOptionUnpack GenerateLineInfo      = (JIT_GENERATE_LINE_INFO,  fromEnum True)
jitOptionUnpack Verbose               = (JIT_LOG_VERBOSE,         fromEnum True)
#else
jitOptionUnpack GenerateDebugInfo     = requireSDK 'GenerateDebugInfo 5.5
jitOptionUnpack GenerateLineInfo      = requireSDK 'GenerateLineInfo 5.5
jitOptionUnpack Verbose               = requireSDK 'Verbose 5.5
#endif

{-# INLINE jitTargetOfCompute #-}
jitTargetOfCompute :: Compute -> JITTarget
jitTargetOfCompute (Compute 1 0) = Compute10
jitTargetOfCompute (Compute 1 1) = Compute11
jitTargetOfCompute (Compute 1 2) = Compute12
jitTargetOfCompute (Compute 1 3) = Compute13
jitTargetOfCompute (Compute 2 0) = Compute20
jitTargetOfCompute (Compute 2 1) = Compute21
jitTargetOfCompute (Compute 3 0) = Compute30
jitTargetOfCompute (Compute 3 5) = Compute35
#if CUDA_VERSION >= 6000
jitTargetOfCompute (Compute 3 2) = Compute32
jitTargetOfCompute (Compute 5 0) = Compute50
#endif
#if CUDA_VERSION >= 6050
jitTargetOfCompute (Compute 3 7) = Compute37
#endif
#if CUDA_VERSION >= 7000
jitTargetOfCompute (Compute 5 2) = Compute52
#endif
jitTargetOfCompute compute       = error ("Unknown JIT Target for Compute " ++ show compute)

{-# INLINE c_strnlen' #-}
#if defined(WIN32)
c_strnlen' :: CString -> CSize -> IO CSize
c_strnlen' str size = do
  str' <- peekCStringLen (str, fromIntegral size)
  return $ stringLen 0 str'
  where
    stringLen acc []       = acc
    stringLen acc ('\0':_) = acc
    stringLen acc (_:xs)   = stringLen (acc+1) xs
#else
foreign import ccall unsafe "string.h strnlen" c_strnlen'
  :: CString -> CSize -> IO CSize
#endif

{-# INLINE c_strnlen #-}
c_strnlen :: CString -> Int -> IO Int
c_strnlen str maxlen = cIntConv `fmap` c_strnlen' str (cIntConv maxlen)


Add function sourceCompletionShow

Add function sourceCompletionShow

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SourceCompletion
--
--  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.SourceCompletion (
-- * Types
    SourceCompletion,
    SourceCompletionClass,

-- * Methods
    sourceCompletionAddProvider,
    sourceCompletionRemoveProvider,
    sourceCompletionGetProviders,
    sourceCompletionShow,
    sourceCompletionHide,
    sourceCompletionGetInfoWindow,
    sourceCompletionCreateContext,
    sourceCompletionMoveWindow,
    sourceCompletionBlockInteractive,
    sourceCompletionUnblockInteractive,

-- * Attributes
    sourceCompletionAccelerators,
    sourceCompletionAutoCompleteDelay,
    sourceCompletionProposalPageSize,
    sourceCompletionProviderPageSize,
    sourceCompletionRememberInfoVisibility,
    sourceCompletionSelectOnShow,
    sourceCompletionShowHeaders,
    sourceCompletionShowIcons,
    sourceCompletionView,

-- * Signals
    sourceCompletionActivateProposal,
    sourceCompletionHideSignal,
    sourceCompletionMoveCursor,
    sourceCompletionMovePage,
    sourceCompletionPopulateContext,
    sourceCompletionShowSignal,
) where

import Control.Monad	(liftM)
import Data.Maybe (fromMaybe)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject	(makeNewGObject)
import System.Glib.Attributes
import System.Glib.Properties
import System.Glib.GError
import System.Glib.GList		(fromGList, withGList)
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import Graphics.UI.Gtk.Multiline.TextView (TextWindowType (..))
import Graphics.UI.Gtk.General.Enums (ScrollStep (..))
{#import Graphics.UI.Gtk.SourceView.Signals#}
{#import Graphics.UI.Gtk.SourceView.Types#}

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

-- | Add a new 'SourceCompletionProvider' to the completion object. This will add a reference provider,
-- so make sure to unref your own copy when you no longer need it.
sourceCompletionAddProvider :: SourceCompletionClass sc => sc
                            -> SourceCompletionProvider
                            -> IO Bool -- ^ returns    'True' if provider was successfully added, otherwise if error is provided, it will be set with the error and
sourceCompletionAddProvider sc provider =
  liftM toBool $
  propagateGError $ \gErrorPtr ->
      {# call gtk_source_completion_add_provider #}
          (toSourceCompletion sc)
          provider
          gErrorPtr

-- | Remove provider from the completion.
sourceCompletionRemoveProvider :: SourceCompletionClass sc => sc
                               -> SourceCompletionProvider
                               -> IO Bool  -- ^ returns    'True' if provider was successfully removed, otherwise if error is provided, it will be set with the error and
sourceCompletionRemoveProvider sc provider =
  liftM toBool $
  propagateGError $ \gErrorPtr ->
      {#call gtk_source_completion_remove_provider #}
         (toSourceCompletion sc)
         provider
         gErrorPtr

-- | Get list of providers registered on completion. The returned list is owned by the completion and
-- should not be freed.
sourceCompletionGetProviders :: SourceCompletionClass sc => sc -> IO [SourceCompletionProvider]
sourceCompletionGetProviders sc = do
  glist <- {#call gtk_source_completion_get_providers #} (toSourceCompletion sc)
  glistPtrs <- fromGList glist
  mapM (makeNewGObject mkSourceCompletionProvider . return) glistPtrs

-- | Starts a new completion with the specified 'SourceCompletionContext' and a list of potential
-- candidate providers for completion.
sourceCompletionShow :: SourceCompletionClass sc => sc
                     -> [SourceCompletionProvider] -- ^ @providers@  A list of 'SourceCompletionProvider'
                     -> SourceCompletionContext -- ^ @context@    The 'SourceCompletionContext' with which to start the completion
                     -> IO Bool -- ^ returns    'True' if it was possible to the show completion window.
sourceCompletionShow sc providers context =
  liftM toBool $
  withForeignPtrs (map unSourceCompletionProvider providers) $ \providersPtr ->
  withGList providersPtr $ \glist ->
  {#call gtk_source_completion_show #}
    (toSourceCompletion sc)
    glist
    context

-- | Hides the completion if it is active (visible).
sourceCompletionHide :: SourceCompletionClass sc => sc -> IO ()
sourceCompletionHide sc =
  {#call gtk_source_completion_hide #} (toSourceCompletion sc)

-- | The info widget is the window where the completion displays optional extra information of the
-- proposal.
sourceCompletionGetInfoWindow :: SourceCompletionClass sc => sc -> IO SourceCompletionInfo
sourceCompletionGetInfoWindow sc =
  makeNewObject mkSourceCompletionInfo $
  {#call gtk_source_completion_get_info_window #}
    (toSourceCompletion sc)

-- | Create a new 'SourceCompletionContext' for completion. The position at which the completion using
-- the new context will consider completion can be provider by position. If position is 'Nothing', the
-- current cursor position will be used.
sourceCompletionCreateContext :: SourceCompletionClass sc => sc
                              -> Maybe TextIter
                              -> IO SourceCompletionContext
sourceCompletionCreateContext sc iter =
  makeNewGObject mkSourceCompletionContext $
  {#call gtk_source_completion_create_context #}
    (toSourceCompletion sc)
    (fromMaybe (TextIter nullForeignPtr) iter)

-- | Move the completion window to a specific iter.
sourceCompletionMoveWindow :: SourceCompletionClass sc => sc
                           -> TextIter
                           -> IO ()
sourceCompletionMoveWindow sc iter =
  {#call gtk_source_completion_move_window #}
    (toSourceCompletion sc)
    iter

-- | Block interactive completion. This can be used to disable interactive completion when inserting or
-- deleting text from the buffer associated with the completion. Use
-- 'sourceCompletionUnblockInteractive' to enable interactive completion again.
sourceCompletionBlockInteractive :: SourceCompletionClass sc => sc -> IO ()
sourceCompletionBlockInteractive sc =
  {#call gtk_source_completion_block_interactive #}
     (toSourceCompletion sc)

-- | Unblock interactive completion. This can be used after using 'sourceCompletionBlockInteractive'
-- to enable interactive completion again.
sourceCompletionUnblockInteractive :: SourceCompletionClass sc => sc -> IO ()
sourceCompletionUnblockInteractive sc =
  {#call gtk_source_completion_unblock_interactive #}
     (toSourceCompletion sc)

-- | Number of accelerators to show for the first proposals.
--
-- Allowed values: <= 10
--
-- Default value: 5
--
sourceCompletionAccelerators :: SourceCompletionClass sc => Attr sc Int
sourceCompletionAccelerators = newAttrFromIntProperty "accelerators"

-- | Determines the popup delay (in milliseconds) at which the completion will be shown for interactive
-- completion.
--
-- Default value: 250
--
sourceCompletionAutoCompleteDelay :: SourceCompletionClass sc => Attr sc Int
sourceCompletionAutoCompleteDelay = newAttrFromIntProperty "auto-complete-delay"

-- | The scroll page size of the proposals in the completion window.
--
-- Allowed values: >= 1
--
-- Default value: 5
--
sourceCompletionProposalPageSize :: SourceCompletionClass sc => Attr sc Int
sourceCompletionProposalPageSize = newAttrFromIntProperty "proposal-page-size"

-- | The scroll page size of the provider pages in the completion window.
--
-- Allowed values: >= 1
--
-- Default value: 5
--
sourceCompletionProviderPageSize :: SourceCompletionClass sc => Attr sc Int
sourceCompletionProviderPageSize = newAttrFromIntProperty "provider-page-size"

-- | Determines whether the visibility of the info window should be saved when the completion is hidden,
-- and restored when the completion is shown again.
--
-- Default value: 'False'
--
sourceCompletionRememberInfoVisibility :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionRememberInfoVisibility = newAttrFromBoolProperty "remember-info-visibility"

-- | Determines whether the first proposal should be selected when the completion is first shown.
--
-- Default value: 'True'
--
sourceCompletionSelectOnShow :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionSelectOnShow = newAttrFromBoolProperty "select-on-show"

-- | Determines whether provider headers should be shown in the proposal list if there is more than one
-- provider with proposals.
--
-- Default value: 'True'
sourceCompletionShowHeaders :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionShowHeaders = newAttrFromBoolProperty "show-headers"

-- | Determines whether provider and proposal icons should be shown in the completion popup.
--
-- Default value: 'True'
--
sourceCompletionShowIcons :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionShowIcons = newAttrFromBoolProperty "show-icons"

-- | The 'SourceView' bound to the completion object.
--
sourceCompletionView :: SourceCompletionClass sc => Attr sc SourceView
sourceCompletionView = newAttrFromObjectProperty "view"
                       {#call pure unsafe gtk_source_view_get_type #}

-- | The 'activateProposal' signal is a keybinding signal which gets emitted when the user initiates a
-- proposal activation.
--
-- Applications should not connect to it, but may emit it with @gSignalEmitByName@ if they need to
-- control the proposal activation programmatically.
sourceCompletionActivateProposal :: SourceCompletionClass sc => Signal sc (IO ())
sourceCompletionActivateProposal =
  Signal $ connect_NONE__NONE "activate_proposal"

-- | Emitted when the completion window is hidden. The default handler will actually hide the window.
sourceCompletionHideSignal :: SourceCompletionClass sc => Signal sc (IO ())
sourceCompletionHideSignal =
  Signal $ connect_NONE__NONE "hide"

-- | The 'moveCursor' signal is a keybinding signal which gets emitted when the user initiates a cursor
-- movement.
--
-- Applications should not connect to it, but may emit it with @gSignalEmitByName@ if they need to
-- control the cursor programmatically.
sourceCompletionMoveCursor :: SourceCompletionClass sc => Signal sc (ScrollStep -> Int -> IO ())
sourceCompletionMoveCursor =
  Signal $ connect_ENUM_INT__NONE "move_cursor"

-- | The 'movePage' signal is a keybinding signal which gets emitted when the user initiates a page
-- movement (i.e. switches between provider pages).
--
-- Applications should not connect to it, but may emit it with @gSignalEmitByName@ if they need to
-- control the page selection programmatically.
sourceCompletionMovePage :: SourceCompletionClass sc => Signal sc (ScrollStep -> Int -> IO ())
sourceCompletionMovePage =
  Signal $ connect_ENUM_INT__NONE "move_page"

-- | Emitted just before starting to populate the completion with providers. You can use this signal to
-- add additional attributes in the context.
sourceCompletionPopulateContext :: SourceCompletionClass sc => Signal sc (SourceCompletionContext -> IO ())
sourceCompletionPopulateContext = Signal $ connect_OBJECT__NONE "populate_context"

-- | Emitted when the completion window is shown. The default handler will actually show the window.
sourceCompletionShowSignal :: SourceCompletionClass sc => Signal sc (IO ())
sourceCompletionShowSignal =
  Signal $ connect_NONE__NONE "show"

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SourceCompletion
--
--  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.SourceCompletion (
-- * Types
    SourceCompletion,
    SourceCompletionClass,

-- * Methods
    sourceCompletionAddProvider,
    sourceCompletionRemoveProvider,
    sourceCompletionGetProviders,
    -- sourceCompletionShow,
    sourceCompletionHide,
    sourceCompletionGetInfoWindow,
    sourceCompletionCreateContext,
    sourceCompletionMoveWindow,
    sourceCompletionBlockInteractive,
    sourceCompletionUnblockInteractive,

-- * Attributes
    sourceCompletionAccelerators,
    sourceCompletionAutoCompleteDelay,
    sourceCompletionProposalPageSize,
    sourceCompletionProviderPageSize,
    sourceCompletionRememberInfoVisibility,
    sourceCompletionSelectOnShow,
    sourceCompletionShowHeaders,
    sourceCompletionShowIcons,
    sourceCompletionView,

-- * Signals
    sourceCompletionActivateProposal,
    sourceCompletionHideSignal,
    sourceCompletionMoveCursor,
    sourceCompletionMovePage,
    sourceCompletionPopulateContext,
    sourceCompletionShowSignal,
) where

import Control.Monad	(liftM)
import Data.Maybe (fromMaybe)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject	(makeNewGObject)
import System.Glib.Attributes
import System.Glib.Properties
import System.Glib.GError
import System.Glib.GList		(fromGList, withGList)
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import Graphics.UI.Gtk.Multiline.TextView (TextWindowType (..))
import Graphics.UI.Gtk.General.Enums (ScrollStep (..))
{#import Graphics.UI.Gtk.SourceView.Signals#}
{#import Graphics.UI.Gtk.SourceView.Types#}

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

-- | Add a new 'SourceCompletionProvider' to the completion object. This will add a reference provider,
-- so make sure to unref your own copy when you no longer need it.
sourceCompletionAddProvider :: SourceCompletionClass sc => sc
                            -> SourceCompletionProvider
                            -> IO Bool -- ^ returns    'True' if provider was successfully added, otherwise if error is provided, it will be set with the error and
sourceCompletionAddProvider sc provider =
  liftM toBool $
  propagateGError $ \gErrorPtr ->
      {# call gtk_source_completion_add_provider #}
          (toSourceCompletion sc)
          provider
          gErrorPtr

-- | Remove provider from the completion.
sourceCompletionRemoveProvider :: SourceCompletionClass sc => sc
                               -> SourceCompletionProvider
                               -> IO Bool  -- ^ returns    'True' if provider was successfully removed, otherwise if error is provided, it will be set with the error and
sourceCompletionRemoveProvider sc provider =
  liftM toBool $
  propagateGError $ \gErrorPtr ->
      {#call gtk_source_completion_remove_provider #}
         (toSourceCompletion sc)
         provider
         gErrorPtr

-- | Get list of providers registered on completion. The returned list is owned by the completion and
-- should not be freed.
sourceCompletionGetProviders :: SourceCompletionClass sc => sc -> IO [SourceCompletionProvider]
sourceCompletionGetProviders sc = do
  glist <- {#call gtk_source_completion_get_providers #} (toSourceCompletion sc)
  glistPtrs <- fromGList glist
  mapM (makeNewGObject mkSourceCompletionProvider . return) glistPtrs

-- | Starts a new completion with the specified 'SourceCompletionContext' and a list of potential
-- candidate providers for completion.
-- sourceCompletionShow :: SourceCompletionClass sc => sc
--                      -> [SourceCompletionProvider]
--                      ->

-- | Hides the completion if it is active (visible).
sourceCompletionHide :: SourceCompletionClass sc => sc -> IO ()
sourceCompletionHide sc =
  {#call gtk_source_completion_hide #} (toSourceCompletion sc)

-- | The info widget is the window where the completion displays optional extra information of the
-- proposal.
sourceCompletionGetInfoWindow :: SourceCompletionClass sc => sc -> IO SourceCompletionInfo
sourceCompletionGetInfoWindow sc =
  makeNewObject mkSourceCompletionInfo $
  {#call gtk_source_completion_get_info_window #}
    (toSourceCompletion sc)

-- | Create a new 'SourceCompletionContext' for completion. The position at which the completion using
-- the new context will consider completion can be provider by position. If position is 'Nothing', the
-- current cursor position will be used.
sourceCompletionCreateContext :: SourceCompletionClass sc => sc
                              -> Maybe TextIter
                              -> IO SourceCompletionContext
sourceCompletionCreateContext sc iter =
  makeNewGObject mkSourceCompletionContext $
  {#call gtk_source_completion_create_context #}
    (toSourceCompletion sc)
    (fromMaybe (TextIter nullForeignPtr) iter)

-- | Move the completion window to a specific iter.
sourceCompletionMoveWindow :: SourceCompletionClass sc => sc
                           -> TextIter
                           -> IO ()
sourceCompletionMoveWindow sc iter =
  {#call gtk_source_completion_move_window #}
    (toSourceCompletion sc)
    iter

-- | Block interactive completion. This can be used to disable interactive completion when inserting or
-- deleting text from the buffer associated with the completion. Use
-- 'sourceCompletionUnblockInteractive' to enable interactive completion again.
sourceCompletionBlockInteractive :: SourceCompletionClass sc => sc -> IO ()
sourceCompletionBlockInteractive sc =
  {#call gtk_source_completion_block_interactive #}
     (toSourceCompletion sc)

-- | Unblock interactive completion. This can be used after using 'sourceCompletionBlockInteractive'
-- to enable interactive completion again.
sourceCompletionUnblockInteractive :: SourceCompletionClass sc => sc -> IO ()
sourceCompletionUnblockInteractive sc =
  {#call gtk_source_completion_unblock_interactive #}
     (toSourceCompletion sc)

-- | Number of accelerators to show for the first proposals.
--
-- Allowed values: <= 10
--
-- Default value: 5
--
sourceCompletionAccelerators :: SourceCompletionClass sc => Attr sc Int
sourceCompletionAccelerators = newAttrFromIntProperty "accelerators"

-- | Determines the popup delay (in milliseconds) at which the completion will be shown for interactive
-- completion.
--
-- Default value: 250
--
sourceCompletionAutoCompleteDelay :: SourceCompletionClass sc => Attr sc Int
sourceCompletionAutoCompleteDelay = newAttrFromIntProperty "auto-complete-delay"

-- | The scroll page size of the proposals in the completion window.
--
-- Allowed values: >= 1
--
-- Default value: 5
--
sourceCompletionProposalPageSize :: SourceCompletionClass sc => Attr sc Int
sourceCompletionProposalPageSize = newAttrFromIntProperty "proposal-page-size"

-- | The scroll page size of the provider pages in the completion window.
--
-- Allowed values: >= 1
--
-- Default value: 5
--
sourceCompletionProviderPageSize :: SourceCompletionClass sc => Attr sc Int
sourceCompletionProviderPageSize = newAttrFromIntProperty "provider-page-size"

-- | Determines whether the visibility of the info window should be saved when the completion is hidden,
-- and restored when the completion is shown again.
--
-- Default value: 'False'
--
sourceCompletionRememberInfoVisibility :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionRememberInfoVisibility = newAttrFromBoolProperty "remember-info-visibility"

-- | Determines whether the first proposal should be selected when the completion is first shown.
--
-- Default value: 'True'
--
sourceCompletionSelectOnShow :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionSelectOnShow = newAttrFromBoolProperty "select-on-show"

-- | Determines whether provider headers should be shown in the proposal list if there is more than one
-- provider with proposals.
--
-- Default value: 'True'
sourceCompletionShowHeaders :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionShowHeaders = newAttrFromBoolProperty "show-headers"

-- | Determines whether provider and proposal icons should be shown in the completion popup.
--
-- Default value: 'True'
--
sourceCompletionShowIcons :: SourceCompletionClass sc => Attr sc Bool
sourceCompletionShowIcons = newAttrFromBoolProperty "show-icons"

-- | The 'SourceView' bound to the completion object.
--
sourceCompletionView :: SourceCompletionClass sc => Attr sc SourceView
sourceCompletionView = newAttrFromObjectProperty "view"
                       {#call pure unsafe gtk_source_view_get_type #}

-- | The 'activateProposal' signal is a keybinding signal which gets emitted when the user initiates a
-- proposal activation.
--
-- Applications should not connect to it, but may emit it with @gSignalEmitByName@ if they need to
-- control the proposal activation programmatically.
sourceCompletionActivateProposal :: SourceCompletionClass sc => Signal sc (IO ())
sourceCompletionActivateProposal =
  Signal $ connect_NONE__NONE "activate_proposal"

-- | Emitted when the completion window is hidden. The default handler will actually hide the window.
sourceCompletionHideSignal :: SourceCompletionClass sc => Signal sc (IO ())
sourceCompletionHideSignal =
  Signal $ connect_NONE__NONE "hide"

-- | The 'moveCursor' signal is a keybinding signal which gets emitted when the user initiates a cursor
-- movement.
--
-- Applications should not connect to it, but may emit it with @gSignalEmitByName@ if they need to
-- control the cursor programmatically.
sourceCompletionMoveCursor :: SourceCompletionClass sc => Signal sc (ScrollStep -> Int -> IO ())
sourceCompletionMoveCursor =
  Signal $ connect_ENUM_INT__NONE "move_cursor"

-- | The 'movePage' signal is a keybinding signal which gets emitted when the user initiates a page
-- movement (i.e. switches between provider pages).
--
-- Applications should not connect to it, but may emit it with @gSignalEmitByName@ if they need to
-- control the page selection programmatically.
sourceCompletionMovePage :: SourceCompletionClass sc => Signal sc (ScrollStep -> Int -> IO ())
sourceCompletionMovePage =
  Signal $ connect_ENUM_INT__NONE "move_page"

-- | Emitted just before starting to populate the completion with providers. You can use this signal to
-- add additional attributes in the context.
sourceCompletionPopulateContext :: SourceCompletionClass sc => Signal sc (SourceCompletionContext -> IO ())
sourceCompletionPopulateContext = Signal $ connect_OBJECT__NONE "populate_context"

-- | Emitted when the completion window is shown. The default handler will actually show the window.
sourceCompletionShowSignal :: SourceCompletionClass sc => Signal sc (IO ())
sourceCompletionShowSignal =
  Signal $ connect_NONE__NONE "show"