{-# LINE 2 "./Graphics/UI/Gtk/General/Selection.chs" #-}
module Graphics.UI.Gtk.General.Selection (
InfoId,
Atom,
TargetTag,
SelectionTag,
SelectionTypeTag,
TargetList,
SelectionDataM,
TargetFlags(..),
targetString,
selectionTypeAtom,
selectionTypeInteger,
selectionTypeString,
atomNew,
targetListNew,
targetListAdd,
targetListAddTextTargets,
targetListAddImageTargets,
targetListAddUriTargets,
targetListAddRichTextTargets,
targetListRemove,
selectionAddTarget,
selectionClearTargets,
selectionOwnerSet,
selectionOwnerSetForDisplay,
selectionRemoveAll,
selectionDataSet,
selectionDataGet,
selectionDataIsValid,
selectionDataSetText,
selectionDataGetText,
selectionDataSetPixbuf,
selectionDataGetPixbuf,
selectionDataSetURIs,
selectionDataGetURIs,
selectionDataTargetsIncludeImage,
selectionDataGetTarget,
selectionDataSetTarget,
selectionDataGetTargets,
selectionDataTargetsIncludeText,
selectionDataTargetsIncludeUri,
selectionDataTargetsIncludeRichText,
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,
selectionDataGetType
)
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" #-}
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
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" #-}
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)
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" #-}
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)
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
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)
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
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)
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)
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)
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))
selectionDataGet_format :: Ptr () -> IO CInt
selectionDataGet_format Ptr ()
selPtr = Ptr () -> IO CInt
gtk_selection_data_get_format Ptr ()
selPtr
selectionDataGet_length :: Ptr () -> IO CInt
selectionDataGet_length Ptr ()
selPtr = Ptr () -> IO CInt
gtk_selection_data_get_length Ptr ()
selPtr
selectionDataGet_data :: Ptr () -> IO (Ptr CUChar)
selectionDataGet_data Ptr ()
selPtr = Ptr () -> IO (Ptr CUChar)
gtk_selection_data_get_data Ptr ()
selPtr
selectionDataGet_target :: Ptr () -> IO (Ptr ())
selectionDataGet_target Ptr ()
selPtr = Ptr () -> IO (Ptr ())
gtk_selection_data_get_target Ptr ()
selPtr
{-# LINE 285 "./Graphics/UI/Gtk/General/Selection.chs" #-}
selectionDataGet :: (Integral a, Storable a) =>
SelectionTypeTag -> SelectionDataM (Maybe [a])
selectionDataGet :: forall a.
(Integral a, Storable a) =>
TargetTag -> SelectionDataM (Maybe [a])
selectionDataGet TargetTag
tagPtr = do
Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Maybe [a]) -> SelectionDataM (Maybe [a])
forall a. IO a -> ReaderT (Ptr ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [a]) -> SelectionDataM (Maybe [a]))
-> IO (Maybe [a]) -> SelectionDataM (Maybe [a])
forall a b. (a -> b) -> a -> b
$ do
TargetTag
typeTag <- Ptr () -> IO TargetTag
selectionDataGetType Ptr ()
selPtr
if TargetTag
typeTagTargetTag -> TargetTag -> Bool
forall a. Eq a => a -> a -> Bool
/=TargetTag
tagPtr then Maybe [a] -> IO (Maybe [a])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
forall a. Maybe a
Nothing else do
Int
bitSize <- (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_format Ptr ()
selPtr
Int
lenBytes <- (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
Ptr a
dataPtr <- (Ptr CUChar -> Ptr a) -> IO (Ptr CUChar) -> IO (Ptr a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr CUChar -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr CUChar) -> IO (Ptr a)) -> IO (Ptr CUChar) -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ptr () -> IO (Ptr CUChar)
selectionDataGet_data Ptr ()
selPtr
if Int
lenBytesInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0 Bool -> Bool -> Bool
|| Int
bitSizeInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=a -> Int
forall a. Storable a => a -> Int
sizeOf (IO a -> a
forall a. IO a -> a
unsafePerformIO (Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
dataPtr))Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8
then Maybe [a] -> IO (Maybe [a])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
forall a. Maybe a
Nothing
else ([a] -> Maybe [a]) -> IO [a] -> IO (Maybe [a])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [a] -> Maybe [a]
forall a. a -> Maybe a
Just (IO [a] -> IO (Maybe [a])) -> IO [a] -> IO (Maybe [a])
forall a b. (a -> b) -> a -> b
$ do
Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lenBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` (Int
bitSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8))) Ptr a
dataPtr
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
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)
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)
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)
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
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
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
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)
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
selectionDataSetTarget :: TargetTag -> SelectionDataM ()
selectionDataSetTarget :: TargetTag -> SelectionDataM ()
selectionDataSetTarget (Atom Ptr ()
targetTag) = do
Ptr ()
selPtr <- ReaderT (Ptr ()) IO (Ptr ())
forall r (m :: * -> *). MonadReader r m => m r
ask
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
$ (\Ptr ()
ptr Ptr ()
val -> do {Ptr () -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
ptr Int
4 (Ptr ()
val::(Ptr ()))}) Ptr ()
selPtr Ptr ()
targetTag
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)
selectionDataTargetsIncludeImage ::
Bool
-> 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)
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
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
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)
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 ())
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_format"
gtk_selection_data_get_format :: ((Ptr ()) -> (IO CInt))
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_data"
gtk_selection_data_get_data :: ((Ptr ()) -> (IO (Ptr CUChar)))
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)))