{-# LINE 2 "./Graphics/UI/Gtk/General/Selection.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Selection support
--
-- Author : Axel Simon
--
-- Created: 26 March 2007
--
-- Copyright (C) 2007 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- functions that seem to be internal: gtk_selection_convert
-- functions that relate to target tables are not bound since they seem
-- superfluous: targets_*, selection_data_copy, selection_data_free
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Functions for handling inter-process communication via selections.
--
module Graphics.UI.Gtk.General.Selection (

-- * Types
  InfoId,
  Atom,
  TargetTag,
  SelectionTag,
  SelectionTypeTag,
  TargetList,
  SelectionDataM,
  TargetFlags(..),

-- * Constants
  targetString,
  selectionTypeAtom,
  selectionTypeInteger,
  selectionTypeString,

-- * Constructors
  atomNew,
  targetListNew,

-- * Methods
  targetListAdd,

  targetListAddTextTargets,
  targetListAddImageTargets,
  targetListAddUriTargets,


  targetListAddRichTextTargets,

  targetListRemove,

  selectionAddTarget,
  selectionClearTargets,
  selectionOwnerSet,
  selectionOwnerSetForDisplay,
  selectionRemoveAll,

  selectionDataSet,



  selectionDataIsValid,
  selectionDataSetText,
  selectionDataGetText,

  selectionDataSetPixbuf,
  selectionDataGetPixbuf,
  selectionDataSetURIs,
  selectionDataGetURIs,
  selectionDataTargetsIncludeImage,

  selectionDataGetTarget,



  selectionDataGetTargets,
  selectionDataTargetsIncludeText,

  selectionDataTargetsIncludeUri,
  selectionDataTargetsIncludeRichText,


-- * Signals
  selectionGet,
  selectionReceived

  ) where

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Flags (fromFlags)
import System.Glib.Signals
import System.Glib.GObject
import Graphics.UI.Gtk.Types
{-# LINE 109 "./Graphics/UI/Gtk/General/Selection.chs" #-}
import Graphics.UI.Gtk.General.DNDTypes
{-# LINE 110 "./Graphics/UI/Gtk/General/Selection.chs" #-}
import Graphics.UI.Gtk.Gdk.Events (TimeStamp)
import Graphics.UI.Gtk.General.Enums (TargetFlags(..))
import Graphics.UI.Gtk.General.Structs (
  targetString,
  selectionTypeAtom,
  selectionTypeInteger,
  selectionTypeString,



  )

import Graphics.UI.Gtk.Signals
import Control.Monad ( liftM )
import Control.Monad.Trans ( liftIO )
import Control.Monad.Reader (runReaderT, ask)


{-# LINE 128 "./Graphics/UI/Gtk/General/Selection.chs" #-}


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

-- | Append another target to the given 'TargetList'.
--
-- * Note that the 'TargetFlags' are only used for drag and drop, not in normal
-- selection handling.
--
targetListAdd :: TargetList -> TargetTag -> [TargetFlags] -> InfoId -> IO ()
targetListAdd :: TargetList -> TargetTag -> [TargetFlags] -> CUInt -> IO ()
targetListAdd TargetList
tl (Atom Ptr ()
tagPtr) [TargetFlags]
flags CUInt
info = do
  (\(TargetList ForeignPtr TargetList
arg1) Ptr ()
arg2 CUInt
arg3 CUInt
arg4 -> ForeignPtr TargetList -> (Ptr TargetList -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TargetList
arg1 ((Ptr TargetList -> IO ()) -> IO ())
-> (Ptr TargetList -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TargetList
argPtr1 ->Ptr TargetList -> Ptr () -> CUInt -> CUInt -> IO ()
gtk_target_list_add Ptr TargetList
argPtr1 Ptr ()
arg2 CUInt
arg3 CUInt
arg4) TargetList
tl Ptr ()
tagPtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([TargetFlags] -> Int
forall a. Flags a => [a] -> Int
fromFlags [TargetFlags]
flags)) CUInt
info



-- | Append all text targets supported by the selection mechanism to the
-- target list. All targets are added with the same 'InfoId'.
--
-- * Since Gtk 2.6.
--
targetListAddTextTargets :: TargetList -> InfoId -> IO ()
targetListAddTextTargets :: TargetList -> CUInt -> IO ()
targetListAddTextTargets = (\(TargetList ForeignPtr TargetList
arg1) CUInt
arg2 -> ForeignPtr TargetList -> (Ptr TargetList -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TargetList
arg1 ((Ptr TargetList -> IO ()) -> IO ())
-> (Ptr TargetList -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TargetList
argPtr1 ->Ptr TargetList -> CUInt -> IO ()
gtk_target_list_add_text_targets Ptr TargetList
argPtr1 CUInt
arg2)
{-# LINE 151 "./Graphics/UI/Gtk/General/Selection.chs" #-}

-- | Append all image targets supported by the selection mechanism to the
-- target list. All targets are added with the same 'InfoId'. If the boolean
-- flag is set, only targets will be added which Gtk+ knows how to convert
-- into a 'Graphics.UI.Gtk.Pixbuf.Pixbuf'.
--
-- * Since Gtk 2.6.
--
targetListAddImageTargets :: TargetList -> InfoId -> Bool -> IO ()
targetListAddImageTargets :: TargetList -> CUInt -> Bool -> IO ()
targetListAddImageTargets TargetList
tl CUInt
info Bool
writable =
  (\(TargetList ForeignPtr TargetList
arg1) CUInt
arg2 CInt
arg3 -> ForeignPtr TargetList -> (Ptr TargetList -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TargetList
arg1 ((Ptr TargetList -> IO ()) -> IO ())
-> (Ptr TargetList -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TargetList
argPtr1 ->Ptr TargetList -> CUInt -> CInt -> IO ()
gtk_target_list_add_image_targets Ptr TargetList
argPtr1 CUInt
arg2 CInt
arg3) TargetList
tl CUInt
info (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
writable)

-- | Append all URI (universal resource indicator, fomerly URL) targets
-- supported by the selection mechanism to the target list. All targets are
-- added with the same 'InfoId'.
--
-- * Since Gtk 2.6.
--
targetListAddUriTargets :: TargetList -> InfoId -> IO ()
targetListAddUriTargets :: TargetList -> CUInt -> IO ()
targetListAddUriTargets = (\(TargetList ForeignPtr TargetList
arg1) CUInt
arg2 -> ForeignPtr TargetList -> (Ptr TargetList -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TargetList
arg1 ((Ptr TargetList -> IO ()) -> IO ())
-> (Ptr TargetList -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TargetList
argPtr1 ->Ptr TargetList -> CUInt -> IO ()
gtk_target_list_add_uri_targets Ptr TargetList
argPtr1 CUInt
arg2)
{-# LINE 171 "./Graphics/UI/Gtk/General/Selection.chs" #-}




-- | Append all rich text targets registered with
-- 'Graphics.UI.Gtk.TextBuffer.textBufferRegisterSerializeFormat' to the
-- target list. All targets are added with the same 'InfoId'. If the boolean
-- flag is @True@ then deserializable rich text formats will be added,
-- serializable formats otherwise.
--
-- * Since Gtk 2.10.
--
targetListAddRichTextTargets :: TextBufferClass tb =>
  TargetList -> InfoId -> Bool -> tb -> IO ()
targetListAddRichTextTargets :: forall tb.
TextBufferClass tb =>
TargetList -> CUInt -> Bool -> tb -> IO ()
targetListAddRichTextTargets TargetList
tl CUInt
info Bool
deser tb
tb =
  (\(TargetList ForeignPtr TargetList
arg1) CUInt
arg2 CInt
arg3 (TextBuffer ForeignPtr TextBuffer
arg4) -> ForeignPtr TargetList -> (Ptr TargetList -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TargetList
arg1 ((Ptr TargetList -> IO ()) -> IO ())
-> (Ptr TargetList -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TargetList
argPtr1 ->ForeignPtr TextBuffer -> (Ptr TextBuffer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextBuffer
arg4 ((Ptr TextBuffer -> IO ()) -> IO ())
-> (Ptr TextBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TextBuffer
argPtr4 ->Ptr TargetList -> CUInt -> CInt -> Ptr TextBuffer -> IO ()
gtk_target_list_add_rich_text_targets Ptr TargetList
argPtr1 CUInt
arg2 CInt
arg3 Ptr TextBuffer
argPtr4) TargetList
tl CUInt
info
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
deser) (tb -> TextBuffer
forall o. TextBufferClass o => o -> TextBuffer
toTextBuffer tb
tb)



-- | Remove a target from a target list.
--
targetListRemove :: TargetList -> TargetTag -> IO ()
targetListRemove :: TargetList -> TargetTag -> IO ()
targetListRemove TargetList
tl (Atom Ptr ()
t)= (\(TargetList ForeignPtr TargetList
arg1) Ptr ()
arg2 -> ForeignPtr TargetList -> (Ptr TargetList -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TargetList
arg1 ((Ptr TargetList -> IO ()) -> IO ())
-> (Ptr TargetList -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TargetList
argPtr1 ->Ptr TargetList -> Ptr () -> IO ()
gtk_target_list_remove Ptr TargetList
argPtr1 Ptr ()
arg2) TargetList
tl Ptr ()
t


-- %hash c:9971 d:af3f
-- | Appends a specified target to the list of supported targets for a given
-- widget and selection.
--
selectionAddTarget :: WidgetClass widget => widget -> SelectionTag ->
                      TargetTag -> InfoId -> IO ()
selectionAddTarget :: forall widget.
WidgetClass widget =>
widget -> TargetTag -> TargetTag -> CUInt -> IO ()
selectionAddTarget widget
widget (Atom Ptr ()
selection) (Atom Ptr ()
target) CUInt
info =
  (\(Widget ForeignPtr Widget
arg1) Ptr ()
arg2 Ptr ()
arg3 CUInt
arg4 -> ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg1 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr1 ->Ptr Widget -> Ptr () -> Ptr () -> CUInt -> IO ()
gtk_selection_add_target Ptr Widget
argPtr1 Ptr ()
arg2 Ptr ()
arg3 CUInt
arg4)
{-# LINE 205 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    (toWidget widget)
    Ptr ()
selection
    Ptr ()
target
    (CUInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
info)

-- %hash c:d523 d:af3f
-- | Remove all targets registered for the given selection for the widget.
--
selectionClearTargets :: WidgetClass widget => widget -> SelectionTag -> IO ()
selectionClearTargets :: forall widget. WidgetClass widget => widget -> TargetTag -> IO ()
selectionClearTargets widget
widget (Atom Ptr ()
selection) =
  (\(Widget ForeignPtr Widget
arg1) Ptr ()
arg2 -> ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg1 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr1 ->Ptr Widget -> Ptr () -> IO ()
gtk_selection_clear_targets Ptr Widget
argPtr1 Ptr ()
arg2)
{-# LINE 216 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    (toWidget widget)
    Ptr ()
selection

-- %hash c:85a8 d:af3f
-- | Claims ownership of a given selection for a particular widget, or, if
-- widget is 'Nothing', release ownership of the selection.
--
selectionOwnerSet :: WidgetClass widget => Maybe widget -> SelectionTag ->
  TimeStamp -> IO Bool
selectionOwnerSet :: forall widget.
WidgetClass widget =>
Maybe widget -> TargetTag -> TimeStamp -> IO Bool
selectionOwnerSet Maybe widget
widget (Atom Ptr ()
selection) TimeStamp
time =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Widget ForeignPtr Widget
arg1) Ptr ()
arg2 CUInt
arg3 -> ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg1 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr1 ->Ptr Widget -> Ptr () -> CUInt -> IO CInt
gtk_selection_owner_set Ptr Widget
argPtr1 Ptr ()
arg2 CUInt
arg3)
{-# LINE 228 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    (maybe (Widget nullForeignPtr) toWidget widget)
    Ptr ()
selection
    (TimeStamp -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeStamp
time)

-- %hash c:174 d:af3f
-- | Set the ownership of a given selection and display.
--
selectionOwnerSetForDisplay :: WidgetClass widget => Display -> Maybe widget ->
  SelectionTag -> TimeStamp -> IO Bool
selectionOwnerSetForDisplay :: forall widget.
WidgetClass widget =>
Display -> Maybe widget -> TargetTag -> TimeStamp -> IO Bool
selectionOwnerSetForDisplay Display
display Maybe widget
widget (Atom Ptr ()
selection) TimeStamp
time =
 (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Display ForeignPtr Display
arg1) (Widget ForeignPtr Widget
arg2) Ptr ()
arg3 CUInt
arg4 -> ForeignPtr Display -> (Ptr Display -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Display
arg1 ((Ptr Display -> IO CInt) -> IO CInt)
-> (Ptr Display -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Display
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO CInt) -> IO CInt)
-> (Ptr Widget -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Display -> Ptr Widget -> Ptr () -> CUInt -> IO CInt
gtk_selection_owner_set_for_display Ptr Display
argPtr1 Ptr Widget
argPtr2 Ptr ()
arg3 CUInt
arg4)
{-# LINE 240 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    display
    (Widget -> (widget -> Widget) -> Maybe widget -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe widget
widget)
    Ptr ()
selection
    (TimeStamp -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeStamp
time)

-- %hash c:c29 d:af3f
-- | Removes all handlers and unsets ownership of all selections for a widget.
-- Called when widget is being destroyed. This function will not generally be
-- called by applications.
--
selectionRemoveAll :: WidgetClass widget => widget -> IO ()
selectionRemoveAll :: forall widget. WidgetClass widget => widget -> IO ()
selectionRemoveAll widget
widget =
  (\(Widget ForeignPtr Widget
arg1) -> ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg1 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr1 ->Ptr Widget -> IO ()
gtk_selection_remove_all Ptr Widget
argPtr1)
{-# LINE 253 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    (toWidget widget)

-- %hash c:7662 d:af3f
-- | Stores new data in the 'SelectionDataM' monad. The stored data may only
-- be an array of integer types that are no larger than 32 bits.
--
selectionDataSet :: (Integral a, Storable a) => SelectionTypeTag -> [a] ->
                                                SelectionDataM ()
selectionDataSet :: forall a.
(Integral a, Storable a) =>
TargetTag -> [a] -> SelectionDataM ()
selectionDataSet (Atom Ptr ()
tagPtr) values :: [a]
values@(~(a
v:[a]
_)) = ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr ()) IO (Ptr ())
-> (Ptr () -> SelectionDataM ()) -> SelectionDataM ()
forall a b.
ReaderT (Ptr ()) IO a
-> (a -> ReaderT (Ptr ()) IO b) -> ReaderT (Ptr ()) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
selPtr ->
  IO () -> SelectionDataM ()
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SelectionDataM ()) -> IO () -> SelectionDataM ()
forall a b. (a -> b) -> a -> b
$ [a] -> (Int -> Ptr a -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
values ((Int -> Ptr a -> IO ()) -> IO ())
-> (Int -> Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
arrayLen Ptr a
arrayPtr ->
  Ptr () -> Ptr () -> CInt -> Ptr CUChar -> CInt -> IO ()
gtk_selection_data_set Ptr ()
selPtr Ptr ()
tagPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
*a -> Int
forall a. Storable a => a -> Int
sizeOf a
v))
    (Ptr a -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
arrayPtr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
arrayLenInt -> Int -> Int
forall a. Num a => a -> a -> a
*a -> Int
forall a. Storable a => a -> Int
sizeOf a
v))

-- The GtkSelectionData struct was made opaque in Gtk3, but the accessor routines
-- where introduced in 2.14.




selectionDataGet_length :: Ptr () -> IO CInt
selectionDataGet_length Ptr ()
selPtr = Ptr () -> IO CInt
gtk_selection_data_get_length Ptr ()
selPtr



selectionDataGet_target :: Ptr () -> IO (Ptr ())
selectionDataGet_target Ptr ()
selPtr = Ptr () -> IO (Ptr ())
gtk_selection_data_get_target Ptr ()
selPtr
{-# LINE 306 "./Graphics/UI/Gtk/General/Selection.chs" #-}
selectionDataGetLength :: SelectionDataM Int
selectionDataGetLength :: SelectionDataM Int
selectionDataGetLength = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO Int -> SelectionDataM Int
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> SelectionDataM Int) -> IO Int -> SelectionDataM Int
forall a b. (a -> b) -> a -> b
$ (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr () -> IO CInt
selectionDataGet_length Ptr ()
selPtr

-- | Check if the currently stored data is valid.
--
-- * If this function returns @False@, no data is set in this selection
-- and 'selectionDataGet' will return @Nothing@ no matter what type
-- is requested.
--
selectionDataIsValid :: SelectionDataM Bool
selectionDataIsValid :: SelectionDataM Bool
selectionDataIsValid = do
  Int
len <- SelectionDataM Int
selectionDataGetLength
  Bool -> SelectionDataM Bool
forall a. a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
lenInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0)

-- %hash c:9bdf d:af3f
-- | Sets the contents of the selection from a string. The
-- string is converted to the form determined by the allowed targets of the
-- selection.
--
-- * Returns @True@ if setting the text was successful.
--
selectionDataSetText :: GlibString string => string -> SelectionDataM Bool
selectionDataSetText :: forall string. GlibString string => string -> SelectionDataM Bool
selectionDataSetText string
str = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  (CInt -> Bool) -> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool)
-> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ IO CInt -> ReaderT (Ptr ()) IO CInt
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ReaderT (Ptr ()) IO CInt)
-> IO CInt -> ReaderT (Ptr ()) IO CInt
forall a b. (a -> b) -> a -> b
$ string -> (CStringLen -> IO CInt) -> IO CInt
forall a. string -> (CStringLen -> IO a) -> IO a
forall s a. GlibString s => s -> (CStringLen -> IO a) -> IO a
withUTFStringLen string
str ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
strPtr,Int
len) ->
    Ptr () -> Ptr CChar -> CInt -> IO CInt
gtk_selection_data_set_text Ptr ()
selPtr Ptr CChar
strPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

-- %hash c:90e0 d:af3f
-- | Gets the contents of the selection data as a string.
--
selectionDataGetText :: GlibString string => SelectionDataM (Maybe string)
selectionDataGetText :: forall string. GlibString string => SelectionDataM (Maybe string)
selectionDataGetText = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (Maybe string) -> SelectionDataM (Maybe string)
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe string) -> SelectionDataM (Maybe string))
-> IO (Maybe string) -> SelectionDataM (Maybe string)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CUChar
strPtr <- Ptr () -> IO (Ptr CUChar)
gtk_selection_data_get_text Ptr ()
selPtr
    if Ptr CUChar
strPtrPtr CUChar -> Ptr CUChar -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr CUChar
forall a. Ptr a
nullPtr then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing else do
      string
str <- Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
strPtr)
      Ptr () -> IO ()
g_free (Ptr CUChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
strPtr)
      Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (string -> Maybe string
forall a. a -> Maybe a
Just string
str)


-- %hash c:ed8d d:af3f
-- | Sets the contents of the selection from a 'Pixbuf'. The pixbuf is
-- converted to the form determined by the allowed targets of the selection.
--
-- * Returns @True@ if setting the 'Pixbuf' was successful. Since Gtk 2.6.
--
selectionDataSetPixbuf :: Pixbuf -> SelectionDataM Bool
selectionDataSetPixbuf :: Pixbuf -> SelectionDataM Bool
selectionDataSetPixbuf Pixbuf
pixbuf = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  (CInt -> Bool) -> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool)
-> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ IO CInt -> ReaderT (Ptr ()) IO CInt
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ReaderT (Ptr ()) IO CInt)
-> IO CInt -> ReaderT (Ptr ()) IO CInt
forall a b. (a -> b) -> a -> b
$
    (\Ptr ()
arg1 (Pixbuf ForeignPtr Pixbuf
arg2) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg2 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr2 ->Ptr () -> Ptr Pixbuf -> IO CInt
gtk_selection_data_set_pixbuf Ptr ()
arg1 Ptr Pixbuf
argPtr2) Ptr ()
selPtr Pixbuf
pixbuf

-- %hash c:52cd d:af3f
-- | Gets the contents of the selection data as a 'Pixbuf'.
--
-- * Since Gtk 2.6.
--
selectionDataGetPixbuf :: SelectionDataM (Maybe Pixbuf)
selectionDataGetPixbuf :: SelectionDataM (Maybe Pixbuf)
selectionDataGetPixbuf = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (Maybe Pixbuf) -> SelectionDataM (Maybe Pixbuf)
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> SelectionDataM (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> SelectionDataM (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ (IO (Ptr Pixbuf) -> IO Pixbuf)
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf) (IO (Ptr Pixbuf) -> IO (Maybe Pixbuf))
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$
    Ptr () -> IO (Ptr Pixbuf)
gtk_selection_data_get_pixbuf Ptr ()
selPtr

-- %hash c:d222 d:af3f
-- | Sets the contents of the selection from a list of URIs. The string is
-- converted to the form determined by the possible targets of the selection.
--
-- * Returns @True@ if setting the URIs was successful. Since Gtk 2.6.
--
selectionDataSetURIs :: GlibString string => [string] -> SelectionDataM Bool
selectionDataSetURIs :: forall string. GlibString string => [string] -> SelectionDataM Bool
selectionDataSetURIs [string]
uris = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO Bool -> SelectionDataM Bool
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> SelectionDataM Bool) -> IO Bool -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ [string] -> (Ptr (Ptr CChar) -> IO CInt) -> IO CInt
forall s a.
GlibString s =>
[s] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFStringArray0 [string]
uris ((Ptr (Ptr CChar) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr CChar) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
strPtrPtr ->
      Ptr () -> Ptr (Ptr CChar) -> IO CInt
gtk_selection_data_set_uris Ptr ()
selPtr Ptr (Ptr CChar)
strPtrPtr

-- %hash c:472f d:af3f
-- | Gets the contents of the selection data as list of URIs. Returns
-- @Nothing@ if the selection did not contain any URIs.
--
-- * Since Gtk 2.6.
--
selectionDataGetURIs :: GlibString string => SelectionDataM (Maybe [string])
selectionDataGetURIs :: forall string. GlibString string => SelectionDataM (Maybe [string])
selectionDataGetURIs = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (Maybe [string]) -> SelectionDataM (Maybe [string])
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [string]) -> SelectionDataM (Maybe [string]))
-> IO (Maybe [string]) -> SelectionDataM (Maybe [string])
forall a b. (a -> b) -> a -> b
$ do
    Ptr (Ptr CChar)
strPtrPtr <- Ptr () -> IO (Ptr (Ptr CChar))
gtk_selection_data_get_uris Ptr ()
selPtr
    if Ptr (Ptr CChar)
strPtrPtrPtr (Ptr CChar) -> Ptr (Ptr CChar) -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr (Ptr CChar)
forall a. Ptr a
nullPtr then Maybe [string] -> IO (Maybe [string])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [string]
forall a. Maybe a
Nothing else do
      [string]
uris <- Ptr (Ptr CChar) -> IO [string]
forall s. GlibString s => Ptr (Ptr CChar) -> IO [s]
peekUTFStringArray0 Ptr (Ptr CChar)
strPtrPtr
      Ptr (Ptr CChar) -> IO ()
g_strfreev Ptr (Ptr CChar)
strPtrPtr
      Maybe [string] -> IO (Maybe [string])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([string] -> Maybe [string]
forall a. a -> Maybe a
Just [string]
uris)


-- | Retrieve the currently set 'TargetTag' in the selection.
selectionDataGetTarget :: SelectionDataM TargetTag
selectionDataGetTarget :: SelectionDataM TargetTag
selectionDataGetTarget = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Ptr () -> TargetTag)
-> ReaderT (Ptr ()) IO (Ptr ()) -> SelectionDataM TargetTag
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr () -> TargetTag
Atom (ReaderT (Ptr ()) IO (Ptr ()) -> SelectionDataM TargetTag)
-> ReaderT (Ptr ()) IO (Ptr ()) -> SelectionDataM TargetTag
forall a b. (a -> b) -> a -> b
$ IO (Ptr ()) -> ReaderT (Ptr ()) IO (Ptr ())
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> ReaderT (Ptr ()) IO (Ptr ()))
-> IO (Ptr ()) -> ReaderT (Ptr ()) IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr () -> IO (Ptr ())
selectionDataGet_target Ptr ()
selPtr
{-# LINE 417 "./Graphics/UI/Gtk/General/Selection.chs" #-}
-- %hash c:e659 d:af3f
-- | Queries the content type of the selection data as a list of targets.
-- Whenever the application is asked whether certain targets are acceptable,
-- it is handed a selection that contains a list of 'TargetTag's as payload.
-- A similar result could be achieved using 'selectionDataGet
-- selectionTypeAtom'.
--
selectionDataGetTargets :: SelectionDataM [TargetTag]
selectionDataGetTargets :: SelectionDataM [TargetTag]
selectionDataGetTargets = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO [TargetTag] -> SelectionDataM [TargetTag]
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TargetTag] -> SelectionDataM [TargetTag])
-> IO [TargetTag] -> SelectionDataM [TargetTag]
forall a b. (a -> b) -> a -> b
$ (Ptr CInt -> IO [TargetTag]) -> IO [TargetTag]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO [TargetTag]) -> IO [TargetTag])
-> (Ptr CInt -> IO [TargetTag]) -> IO [TargetTag]
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
nAtomsPtr -> (Ptr (Ptr (Ptr ())) -> IO [TargetTag]) -> IO [TargetTag]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr (Ptr ())) -> IO [TargetTag]) -> IO [TargetTag])
-> (Ptr (Ptr (Ptr ())) -> IO [TargetTag]) -> IO [TargetTag]
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr (Ptr ()))
targetPtrPtr -> do
    Bool
valid <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
      Ptr () -> Ptr (Ptr (Ptr ())) -> Ptr CInt -> IO CInt
gtk_selection_data_get_targets Ptr ()
selPtr Ptr (Ptr (Ptr ()))
targetPtrPtr Ptr CInt
nAtomsPtr
    if Bool -> Bool
not Bool
valid then [TargetTag] -> IO [TargetTag]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
      CInt
len <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
nAtomsPtr
      Ptr (Ptr ())
targetPtr <- Ptr (Ptr (Ptr ())) -> IO (Ptr (Ptr ()))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr ()))
targetPtrPtr
      [Ptr ()]
targetPtrs <- Int -> Ptr (Ptr ()) -> IO [Ptr ()]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len) Ptr (Ptr ())
targetPtr
      Ptr () -> IO ()
g_free (Ptr (Ptr ()) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr ())
targetPtr)
      [TargetTag] -> IO [TargetTag]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ptr () -> TargetTag) -> [Ptr ()] -> [TargetTag]
forall a b. (a -> b) -> [a] -> [b]
map Ptr () -> TargetTag
Atom [Ptr ()]
targetPtrs)


-- %hash c:5a8 d:af3f
-- | Given a 'SelectionDataM' holding a list of targets, determines if any of
-- the targets in targets can be used to provide a 'Pixbuf'.
--
-- * Since Gtk 2.6
--
selectionDataTargetsIncludeImage ::
  Bool -- ^ whether to accept only targets for which GTK+ knows how to convert a
       -- pixbuf into the format
  -> SelectionDataM Bool
selectionDataTargetsIncludeImage :: Bool -> SelectionDataM Bool
selectionDataTargetsIncludeImage Bool
writable = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  (CInt -> Bool) -> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool)
-> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ IO CInt -> ReaderT (Ptr ()) IO CInt
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ReaderT (Ptr ()) IO CInt)
-> IO CInt -> ReaderT (Ptr ()) IO CInt
forall a b. (a -> b) -> a -> b
$
    Ptr () -> CInt -> IO CInt
gtk_selection_data_targets_include_image
{-# LINE 452 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    selPtr
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
writable)


-- %hash c:abe8 d:af3f
-- | Given a 'SelectionDataM' holding a list of targets, determines if any of
-- the targets in targets can be used to provide text.
--
selectionDataTargetsIncludeText :: SelectionDataM Bool
selectionDataTargetsIncludeText :: SelectionDataM Bool
selectionDataTargetsIncludeText = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  (CInt -> Bool) -> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool)
-> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ IO CInt -> ReaderT (Ptr ()) IO CInt
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ReaderT (Ptr ()) IO CInt)
-> IO CInt -> ReaderT (Ptr ()) IO CInt
forall a b. (a -> b) -> a -> b
$
    Ptr () -> IO CInt
gtk_selection_data_targets_include_text
{-# LINE 465 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    selPtr


-- | Given a 'SelectionDataM' holding a list of targets, determines if any of
-- the targets in targets can be used to provide URIs.
--
-- * Since Gtk 2.10
--
selectionDataTargetsIncludeUri :: SelectionDataM Bool
selectionDataTargetsIncludeUri :: SelectionDataM Bool
selectionDataTargetsIncludeUri = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  (CInt -> Bool) -> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool)
-> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ IO CInt -> ReaderT (Ptr ()) IO CInt
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ReaderT (Ptr ()) IO CInt)
-> IO CInt -> ReaderT (Ptr ()) IO CInt
forall a b. (a -> b) -> a -> b
$
    Ptr () -> IO CInt
gtk_selection_data_targets_include_uri
{-# LINE 478 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    selPtr

-- | Given a 'SelectionDataM' holding a list of targets, check if,
-- well, dunno really. FIXME: what does the 'TextBuffer' do?
--
-- * Since Gtk 2.10
--
selectionDataTargetsIncludeRichText :: TextBufferClass tb => tb ->
                                       SelectionDataM Bool
selectionDataTargetsIncludeRichText :: forall tb. TextBufferClass tb => tb -> SelectionDataM Bool
selectionDataTargetsIncludeRichText tb
tb = do
  Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
  (CInt -> Bool) -> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool)
-> ReaderT (Ptr ()) IO CInt -> SelectionDataM Bool
forall a b. (a -> b) -> a -> b
$ IO CInt -> ReaderT (Ptr ()) IO CInt
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ReaderT (Ptr ()) IO CInt)
-> IO CInt -> ReaderT (Ptr ()) IO CInt
forall a b. (a -> b) -> a -> b
$
    (\Ptr ()
arg1 (TextBuffer ForeignPtr TextBuffer
arg2) -> ForeignPtr TextBuffer -> (Ptr TextBuffer -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TextBuffer
arg2 ((Ptr TextBuffer -> IO CInt) -> IO CInt)
-> (Ptr TextBuffer -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TextBuffer
argPtr2 ->Ptr () -> Ptr TextBuffer -> IO CInt
gtk_selection_data_targets_include_rich_text Ptr ()
arg1 Ptr TextBuffer
argPtr2)
{-# LINE 491 "./Graphics/UI/Gtk/General/Selection.chs" #-}
    selPtr (tb -> TextBuffer
forall o. TextBufferClass o => o -> TextBuffer
toTextBuffer tb
tb)


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

-- %hash c:f7c3 d:af3f
-- | Pass the supplied selection data to the application. The application is
-- expected to read the data using 'selectionDataGet' or one of its
-- derivatives.
--
selectionReceived :: WidgetClass self => Signal self (TimeStamp -> SelectionDataM ())
selectionReceived :: forall self.
WidgetClass self =>
Signal self (TimeStamp -> SelectionDataM ())
selectionReceived = (Bool
 -> self -> (TimeStamp -> SelectionDataM ()) -> IO (ConnectId self))
-> Signal self (TimeStamp -> SelectionDataM ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (\Bool
after self
object TimeStamp -> SelectionDataM ()
handler -> do
    SignalName
-> Bool -> self -> (Ptr () -> Word -> IO ()) -> IO (ConnectId self)
forall obj a.
GObjectClass obj =>
SignalName
-> Bool -> obj -> (Ptr a -> Word -> IO ()) -> IO (ConnectId obj)
connect_PTR_WORD__NONE SignalName
"selection-received" Bool
after self
object ((Ptr () -> Word -> IO ()) -> IO (ConnectId self))
-> (Ptr () -> Word -> IO ()) -> IO (ConnectId self)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
dataPtr Word
time -> do
      SelectionDataM () -> Ptr () -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (TimeStamp -> SelectionDataM ()
handler (Word -> TimeStamp
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
time)) Ptr ()
dataPtr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- %hash c:c3 d:af3f
-- | Emitted in order to ask the application for selection data. Within the
-- handler the function 'selectionDataSet' or one of its derivatives should be
-- called.
--
selectionGet :: WidgetClass self =>
                Signal self (InfoId -> TimeStamp -> SelectionDataM ())
selectionGet :: forall self.
WidgetClass self =>
Signal self (CUInt -> TimeStamp -> SelectionDataM ())
selectionGet = (Bool
 -> self
 -> (CUInt -> TimeStamp -> SelectionDataM ())
 -> IO (ConnectId self))
-> Signal self (CUInt -> TimeStamp -> SelectionDataM ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (\Bool
after self
object CUInt -> TimeStamp -> SelectionDataM ()
handler -> do
    SignalName
-> Bool
-> self
-> (Ptr () -> Word -> Word -> IO ())
-> IO (ConnectId self)
forall obj a.
GObjectClass obj =>
SignalName
-> Bool
-> obj
-> (Ptr a -> Word -> Word -> IO ())
-> IO (ConnectId obj)
connect_PTR_WORD_WORD__NONE SignalName
"selection-get" Bool
after self
object ((Ptr () -> Word -> Word -> IO ()) -> IO (ConnectId self))
-> (Ptr () -> Word -> Word -> IO ()) -> IO (ConnectId self)
forall a b. (a -> b) -> a -> b
$
      \Ptr ()
dataPtr Word
info Word
time -> do
      SelectionDataM () -> Ptr () -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (CUInt -> TimeStamp -> SelectionDataM ()
handler (Word -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
info) (Word -> TimeStamp
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
time)) Ptr ()
dataPtr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

foreign import ccall unsafe "gtk_target_list_add"
  gtk_target_list_add :: ((Ptr TargetList) -> ((Ptr ()) -> (CUInt -> (CUInt -> (IO ())))))

foreign import ccall unsafe "gtk_target_list_add_text_targets"
  gtk_target_list_add_text_targets :: ((Ptr TargetList) -> (CUInt -> (IO ())))

foreign import ccall unsafe "gtk_target_list_add_image_targets"
  gtk_target_list_add_image_targets :: ((Ptr TargetList) -> (CUInt -> (CInt -> (IO ()))))

foreign import ccall unsafe "gtk_target_list_add_uri_targets"
  gtk_target_list_add_uri_targets :: ((Ptr TargetList) -> (CUInt -> (IO ())))

foreign import ccall unsafe "gtk_target_list_add_rich_text_targets"
  gtk_target_list_add_rich_text_targets :: ((Ptr TargetList) -> (CUInt -> (CInt -> ((Ptr TextBuffer) -> (IO ())))))

foreign import ccall unsafe "gtk_target_list_remove"
  gtk_target_list_remove :: ((Ptr TargetList) -> ((Ptr ()) -> (IO ())))

foreign import ccall unsafe "gtk_selection_add_target"
  gtk_selection_add_target :: ((Ptr Widget) -> ((Ptr ()) -> ((Ptr ()) -> (CUInt -> (IO ())))))

foreign import ccall unsafe "gtk_selection_clear_targets"
  gtk_selection_clear_targets :: ((Ptr Widget) -> ((Ptr ()) -> (IO ())))

foreign import ccall unsafe "gtk_selection_owner_set"
  gtk_selection_owner_set :: ((Ptr Widget) -> ((Ptr ()) -> (CUInt -> (IO CInt))))

foreign import ccall unsafe "gtk_selection_owner_set_for_display"
  gtk_selection_owner_set_for_display :: ((Ptr Display) -> ((Ptr Widget) -> ((Ptr ()) -> (CUInt -> (IO CInt)))))

foreign import ccall unsafe "gtk_selection_remove_all"
  gtk_selection_remove_all :: ((Ptr Widget) -> (IO ()))

foreign import ccall unsafe "gtk_selection_data_set"
  gtk_selection_data_set :: ((Ptr ()) -> ((Ptr ()) -> (CInt -> ((Ptr CUChar) -> (CInt -> (IO ()))))))

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

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

foreign import ccall unsafe "gtk_selection_data_set_text"
  gtk_selection_data_set_text :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (IO CInt))))

foreign import ccall unsafe "gtk_selection_data_get_text"
  gtk_selection_data_get_text :: ((Ptr ()) -> (IO (Ptr CUChar)))

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

foreign import ccall unsafe "gtk_selection_data_set_pixbuf"
  gtk_selection_data_set_pixbuf :: ((Ptr ()) -> ((Ptr Pixbuf) -> (IO CInt)))

foreign import ccall unsafe "gtk_selection_data_get_pixbuf"
  gtk_selection_data_get_pixbuf :: ((Ptr ()) -> (IO (Ptr Pixbuf)))

foreign import ccall unsafe "gtk_selection_data_set_uris"
  gtk_selection_data_set_uris :: ((Ptr ()) -> ((Ptr (Ptr CChar)) -> (IO CInt)))

foreign import ccall unsafe "gtk_selection_data_get_uris"
  gtk_selection_data_get_uris :: ((Ptr ()) -> (IO (Ptr (Ptr CChar))))

foreign import ccall unsafe "g_strfreev"
  g_strfreev :: ((Ptr (Ptr CChar)) -> (IO ()))

foreign import ccall unsafe "gtk_selection_data_get_targets"
  gtk_selection_data_get_targets :: ((Ptr ()) -> ((Ptr (Ptr (Ptr ()))) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall unsafe "gtk_selection_data_targets_include_image"
  gtk_selection_data_targets_include_image :: ((Ptr ()) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "gtk_selection_data_targets_include_text"
  gtk_selection_data_targets_include_text :: ((Ptr ()) -> (IO CInt))

foreign import ccall unsafe "gtk_selection_data_targets_include_uri"
  gtk_selection_data_targets_include_uri :: ((Ptr ()) -> (IO CInt))

foreign import ccall unsafe "gtk_selection_data_targets_include_rich_text"
  gtk_selection_data_targets_include_rich_text :: ((Ptr ()) -> ((Ptr TextBuffer) -> (IO CInt)))