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
import Graphics.UI.Gtk.General.DNDTypes
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)
targetListAdd :: TargetList -> TargetTag -> [TargetFlags] -> InfoId -> IO ()
targetListAdd tl (Atom tagPtr) flags info = do
(\(TargetList arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtk_target_list_add argPtr1 arg2 arg3 arg4) tl tagPtr (fromIntegral (fromFlags flags)) info
targetListAddTextTargets :: TargetList -> InfoId -> IO ()
targetListAddTextTargets = (\(TargetList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_target_list_add_text_targets argPtr1 arg2)
targetListAddImageTargets :: TargetList -> InfoId -> Bool -> IO ()
targetListAddImageTargets tl info writable =
(\(TargetList arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_target_list_add_image_targets argPtr1 arg2 arg3) tl info (fromBool writable)
targetListAddUriTargets :: TargetList -> InfoId -> IO ()
targetListAddUriTargets = (\(TargetList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_target_list_add_uri_targets argPtr1 arg2)
targetListAddRichTextTargets :: TextBufferClass tb =>
TargetList -> InfoId -> Bool -> tb -> IO ()
targetListAddRichTextTargets tl info deser tb =
(\(TargetList arg1) arg2 arg3 (TextBuffer arg4) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg4 $ \argPtr4 ->gtk_target_list_add_rich_text_targets argPtr1 arg2 arg3 argPtr4) tl info
(fromBool deser) (toTextBuffer tb)
targetListRemove :: TargetList -> TargetTag -> IO ()
targetListRemove tl (Atom t)= (\(TargetList arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_target_list_remove argPtr1 arg2) tl t
selectionAddTarget :: WidgetClass widget => widget -> SelectionTag ->
TargetTag -> InfoId -> IO ()
selectionAddTarget widget (Atom selection) (Atom target) info =
(\(Widget arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtk_selection_add_target argPtr1 arg2 arg3 arg4)
(toWidget widget)
selection
target
(fromIntegral info)
selectionClearTargets :: WidgetClass widget => widget -> SelectionTag -> IO ()
selectionClearTargets widget (Atom selection) =
(\(Widget arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_selection_clear_targets argPtr1 arg2)
(toWidget widget)
selection
selectionOwnerSet :: WidgetClass widget => Maybe widget -> SelectionTag ->
TimeStamp -> IO Bool
selectionOwnerSet widget (Atom selection) time =
liftM toBool $
(\(Widget arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_selection_owner_set argPtr1 arg2 arg3)
(maybe (Widget nullForeignPtr) toWidget widget)
selection
(fromIntegral time)
selectionOwnerSetForDisplay :: WidgetClass widget => Display -> Maybe widget ->
SelectionTag -> TimeStamp -> IO Bool
selectionOwnerSetForDisplay display widget (Atom selection) time =
liftM toBool $
(\(Display arg1) (Widget arg2) arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_selection_owner_set_for_display argPtr1 argPtr2 arg3 arg4)
display
(maybe (Widget nullForeignPtr) toWidget widget)
selection
(fromIntegral time)
selectionRemoveAll :: WidgetClass widget => widget -> IO ()
selectionRemoveAll widget =
(\(Widget arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_selection_remove_all argPtr1)
(toWidget widget)
selectionDataSet :: (Integral a, Storable a) => SelectionTypeTag -> [a] ->
SelectionDataM ()
selectionDataSet (Atom tagPtr) values@(~(v:_)) = ask >>= \selPtr ->
liftIO $ withArrayLen values $ \arrayLen arrayPtr ->
gtk_selection_data_set selPtr tagPtr (fromIntegral (8*sizeOf v))
(castPtr arrayPtr) (fromIntegral (arrayLen*sizeOf v))
selectionDataGet_format selPtr = gtk_selection_data_get_format selPtr
selectionDataGet_length selPtr = gtk_selection_data_get_length selPtr
selectionDataGet_data selPtr = gtk_selection_data_get_data selPtr
selectionDataGet_target selPtr = gtk_selection_data_get_target selPtr
selectionDataGet :: (Integral a, Storable a) =>
SelectionTypeTag -> SelectionDataM (Maybe [a])
selectionDataGet tagPtr = do
selPtr <- ask
liftIO $ do
typeTag <- selectionDataGetType selPtr
if typeTag/=tagPtr then return Nothing else do
bitSize <- liftM fromIntegral $ selectionDataGet_format selPtr
lenBytes <- liftM fromIntegral $ selectionDataGet_length selPtr
dataPtr <- liftM castPtr $ selectionDataGet_data selPtr
if lenBytes<=0 || bitSize/=sizeOf (unsafePerformIO (peek dataPtr))*8
then return Nothing
else liftM Just $ do
peekArray (fromIntegral (lenBytes `quot` (bitSize `quot` 8))) dataPtr
selectionDataGetLength :: SelectionDataM Int
selectionDataGetLength = do
selPtr <- ask
liftIO $ liftM fromIntegral $ selectionDataGet_length selPtr
selectionDataIsValid :: SelectionDataM Bool
selectionDataIsValid = do
len <- selectionDataGetLength
return (len>=0)
selectionDataSetText :: GlibString string => string -> SelectionDataM Bool
selectionDataSetText str = do
selPtr <- ask
liftM toBool $ liftIO $ withUTFStringLen str $ \(strPtr,len) ->
gtk_selection_data_set_text selPtr strPtr (fromIntegral len)
selectionDataGetText :: GlibString string => SelectionDataM (Maybe string)
selectionDataGetText = do
selPtr <- ask
liftIO $ do
strPtr <- gtk_selection_data_get_text selPtr
if strPtr==nullPtr then return Nothing else do
str <- peekUTFString (castPtr strPtr)
g_free (castPtr strPtr)
return (Just str)
selectionDataSetPixbuf :: Pixbuf -> SelectionDataM Bool
selectionDataSetPixbuf pixbuf = do
selPtr <- ask
liftM toBool $ liftIO $
(\arg1 (Pixbuf arg2) -> withForeignPtr arg2 $ \argPtr2 ->gtk_selection_data_set_pixbuf arg1 argPtr2) selPtr pixbuf
selectionDataGetPixbuf :: SelectionDataM (Maybe Pixbuf)
selectionDataGetPixbuf = do
selPtr <- ask
liftIO $ maybeNull (wrapNewGObject mkPixbuf) $
gtk_selection_data_get_pixbuf selPtr
selectionDataSetURIs :: GlibString string => [string] -> SelectionDataM Bool
selectionDataSetURIs uris = do
selPtr <- ask
liftIO $ liftM toBool $ withUTFStringArray0 uris $ \strPtrPtr ->
gtk_selection_data_set_uris selPtr strPtrPtr
selectionDataGetURIs :: GlibString string => SelectionDataM (Maybe [string])
selectionDataGetURIs = do
selPtr <- ask
liftIO $ do
strPtrPtr <- gtk_selection_data_get_uris selPtr
if strPtrPtr==nullPtr then return Nothing else do
uris <- peekUTFStringArray0 strPtrPtr
g_strfreev strPtrPtr
return (Just uris)
selectionDataGetTarget :: SelectionDataM TargetTag
selectionDataGetTarget = do
selPtr <- ask
liftM Atom $ liftIO $ selectionDataGet_target selPtr
selectionDataSetTarget :: TargetTag -> SelectionDataM ()
selectionDataSetTarget (Atom targetTag) = do
selPtr <- ask
liftIO $ (\ptr val -> do {pokeByteOff ptr 8 (val::(Ptr ()))}) selPtr targetTag
selectionDataGetTargets :: SelectionDataM [TargetTag]
selectionDataGetTargets = do
selPtr <- ask
liftIO $ alloca $ \nAtomsPtr -> alloca $ \targetPtrPtr -> do
valid <- liftM toBool $
gtk_selection_data_get_targets selPtr targetPtrPtr nAtomsPtr
if not valid then return [] else do
len <- peek nAtomsPtr
targetPtr <- peek targetPtrPtr
targetPtrs <- peekArray (fromIntegral len) targetPtr
g_free (castPtr targetPtr)
return (map Atom targetPtrs)
selectionDataTargetsIncludeImage ::
Bool
-> SelectionDataM Bool
selectionDataTargetsIncludeImage writable = do
selPtr <- ask
liftM toBool $ liftIO $
gtk_selection_data_targets_include_image
selPtr
(fromBool writable)
selectionDataTargetsIncludeText :: SelectionDataM Bool
selectionDataTargetsIncludeText = do
selPtr <- ask
liftM toBool $ liftIO $
gtk_selection_data_targets_include_text
selPtr
selectionDataTargetsIncludeUri :: SelectionDataM Bool
selectionDataTargetsIncludeUri = do
selPtr <- ask
liftM toBool $ liftIO $
gtk_selection_data_targets_include_uri
selPtr
selectionDataTargetsIncludeRichText :: TextBufferClass tb => tb ->
SelectionDataM Bool
selectionDataTargetsIncludeRichText tb = do
selPtr <- ask
liftM toBool $ liftIO $
(\arg1 (TextBuffer arg2) -> withForeignPtr arg2 $ \argPtr2 ->gtk_selection_data_targets_include_rich_text arg1 argPtr2)
selPtr (toTextBuffer tb)
selectionReceived :: WidgetClass self => Signal self (TimeStamp -> SelectionDataM ())
selectionReceived = Signal (\after object handler -> do
connect_PTR_WORD__NONE "selection-received" after object $ \dataPtr time -> do
runReaderT (handler (fromIntegral time)) dataPtr >> return ())
selectionGet :: WidgetClass self =>
Signal self (InfoId -> TimeStamp -> SelectionDataM ())
selectionGet = Signal (\after object handler -> do
connect_PTR_WORD_WORD__NONE "selection-get" after object $
\dataPtr info time -> do
runReaderT (handler (fromIntegral info) (fromIntegral time)) dataPtr >>
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)))