File: Selection.chs

package info (click to toggle)
haskell-gtk 0.11.0-5
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 2,920 kB
  • ctags: 82
  • sloc: haskell: 1,929; ansic: 714; sh: 5; makefile: 3
file content (488 lines) | stat: -rw-r--r-- 16,444 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
{-# LANGUAGE CPP #-}
-- -*-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,
#if GTK_CHECK_VERSION(2,6,0)
  targetListAddTextTargets,
  targetListAddImageTargets,
  targetListAddUriTargets,
#endif
#if GTK_CHECK_VERSION(2,10,0)
  targetListAddRichTextTargets,
#endif
  targetListRemove,

  selectionAddTarget,
  selectionClearTargets,
  selectionOwnerSet,
  selectionOwnerSetForDisplay,
  selectionRemoveAll,

  selectionDataSet,
  selectionDataGet,
  selectionDataIsValid,
  selectionDataSetText,
  selectionDataGetText,
#if GTK_CHECK_VERSION(2,6,0)
  selectionDataSetPixbuf,
  selectionDataGetPixbuf,
  selectionDataSetURIs,
  selectionDataGetURIs,
  selectionDataTargetsIncludeImage,
#endif
  selectionDataGetTarget,
  selectionDataSetTarget,
  selectionDataGetTargets,
  selectionDataTargetsIncludeText,
#if GTK_CHECK_VERSION(2,10,0)
  selectionDataTargetsIncludeUri,
  selectionDataTargetsIncludeRichText,
#endif

-- * Signals
  selectionGet,
  selectionReceived

  ) where

import System.Glib.FFI
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 System.Glib.UTFString ( peekUTFString, withUTFStringLen,
                               withUTFStringArray0, peekUTFStringArray0 )
import Control.Monad ( liftM )
import Control.Monad.Trans ( liftIO )
import Control.Monad.Reader (runReaderT, ask)
import Data.Word ( Word32 )

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


--------------------
-- 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 tl (Atom tagPtr) flags info = do
  {#call unsafe target_list_add#} tl tagPtr (fromIntegral (fromFlags flags)) info

#if GTK_CHECK_VERSION(2,6,0)

-- | 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 = {#call unsafe target_list_add_text_targets#}

-- | 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 tl info writable =
  {#call unsafe target_list_add_image_targets#} tl info (fromBool 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 = {#call unsafe target_list_add_uri_targets#}

#endif
#if GTK_CHECK_VERSION(2,10,0)

-- | 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 tl info deser tb =
  {#call unsafe target_list_add_rich_text_targets#} tl info
    (fromBool deser) (toTextBuffer tb)

#endif

-- | Remove a target from a target list.
--
targetListRemove :: TargetList -> TargetTag -> IO ()
targetListRemove tl (Atom t)= {#call unsafe target_list_remove#} tl 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 widget (Atom selection) (Atom target) info =
  {#call unsafe gtk_selection_add_target #}
    (toWidget widget)
    selection
    target
    (fromIntegral info)

-- %hash c:d523 d:af3f
-- | Remove all targets registered for the given selection for the widget.
--
selectionClearTargets :: WidgetClass widget => widget -> SelectionTag -> IO ()
selectionClearTargets widget (Atom selection) =
  {#call unsafe gtk_selection_clear_targets #}
    (toWidget widget)
    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 widget (Atom selection) time =
  liftM toBool $
  {#call unsafe gtk_selection_owner_set #}
    (maybe (Widget nullForeignPtr) toWidget widget)
    selection
    (fromIntegral 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 display widget (Atom selection) time =
 liftM toBool $
  {#call unsafe gtk_selection_owner_set_for_display #}
    display
    (maybe (Widget nullForeignPtr) toWidget widget)
    selection
    (fromIntegral 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 widget =
  {#call unsafe gtk_selection_remove_all #}
    (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 (Atom tagPtr) values@(~(v:_)) = ask >>= \selPtr ->
  liftIO $ withArrayLen values $ \arrayLen arrayPtr ->
  {#call unsafe gtk_selection_data_set #} selPtr tagPtr (fromIntegral (8*sizeOf v))
    (castPtr arrayPtr) (fromIntegral (arrayLen*sizeOf v))

-- | Retreives the data in the 'SelectionDataM' monad. The returned array
--   must have elements of the size that were used to set this data. If
--   the size or the type tag does not match, @Nothing@ is returned.
--
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 $ {#get SelectionData -> format#} selPtr
    lenBytes <- liftM fromIntegral $ {#get SelectionData -> length#} selPtr
    dataPtr <- liftM castPtr $ {#get SelectionData -> 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 $ {#get SelectionData -> length#} 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 = do
  len <- selectionDataGetLength
  return (len>=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 :: String -> SelectionDataM Bool
selectionDataSetText str = do
  selPtr <- ask
  liftM toBool $ liftIO $ withUTFStringLen str $ \(strPtr,len) ->
    {#call unsafe gtk_selection_data_set_text #} selPtr strPtr (fromIntegral len)

-- %hash c:90e0 d:af3f
-- | Gets the contents of the selection data as a string.
--
selectionDataGetText :: SelectionDataM (Maybe String)
selectionDataGetText = do
  selPtr <- ask
  liftIO $ do
    strPtr <- {#call unsafe gtk_selection_data_get_text #} selPtr
    if strPtr==nullPtr then return Nothing else do
      str <- peekUTFString (castPtr strPtr)
      {#call unsafe g_free#} (castPtr strPtr)
      return (Just str)

#if GTK_CHECK_VERSION(2,6,0)
-- %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 = do
  selPtr <- ask
  liftM toBool $ liftIO $
    {#call unsafe gtk_selection_data_set_pixbuf #} selPtr 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 = do
  selPtr <- ask
  liftIO $ maybeNull (constructNewGObject mkPixbuf) $
    {#call unsafe gtk_selection_data_get_pixbuf #} 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 :: [String] -> SelectionDataM Bool
selectionDataSetURIs uris = do
  selPtr <- ask
  liftIO $ liftM toBool $ withUTFStringArray0 uris $ \strPtrPtr ->
      {#call unsafe gtk_selection_data_set_uris #} selPtr 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 :: SelectionDataM (Maybe [String])
selectionDataGetURIs = do
  selPtr <- ask
  liftIO $ do
    strPtrPtr <- {#call unsafe gtk_selection_data_get_uris #} selPtr
    if strPtrPtr==nullPtr then return Nothing else do
      uris <- peekUTFStringArray0 strPtrPtr
      {#call unsafe g_strfreev#} strPtrPtr
      return (Just uris)
#endif

-- | Retrieve the currently set 'TargetTag' in the selection.
selectionDataGetTarget :: SelectionDataM TargetTag
selectionDataGetTarget = do
  selPtr <- ask
  liftM Atom $ liftIO $ {#get SelectionData -> target#} selPtr

-- | Set the selection to the given 'TargetTag'.
selectionDataSetTarget :: TargetTag -> SelectionDataM ()
selectionDataSetTarget (Atom targetTag) = do
  selPtr <- ask
  liftIO $ {#set SelectionData -> target#} selPtr targetTag

-- %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 = do
  selPtr <- ask
  liftIO $ alloca $ \nAtomsPtr -> alloca $ \targetPtrPtr -> do
    valid <- liftM toBool $ 
      {#call unsafe 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
      {#call unsafe g_free#} (castPtr targetPtr)
      return (map Atom targetPtrs)
      
#if GTK_CHECK_VERSION(2,6,0)
-- %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 writable = do
  selPtr <- ask
  liftM toBool $ liftIO $
    {#call unsafe gtk_selection_data_targets_include_image #}
    selPtr
    (fromBool writable)
#endif 

-- %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 = do
  selPtr <- ask
  liftM toBool $ liftIO $
    {#call unsafe gtk_selection_data_targets_include_text #}
    selPtr

#if GTK_CHECK_VERSION(2,10,0)
-- | 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 = do
  selPtr <- ask
  liftM toBool $ liftIO $
    {#call unsafe gtk_selection_data_targets_include_uri #}
    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 tb = do
  selPtr <- ask
  liftM toBool $ liftIO $
    {#call unsafe gtk_selection_data_targets_include_rich_text #}
    selPtr (toTextBuffer tb)
#endif

--------------------
-- 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 = Signal (\after object handler -> do
    connect_PTR_WORD__NONE "selection_received" after object $ \dataPtr time -> do
      runReaderT (handler (fromIntegral time)) dataPtr >> 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 = 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 ())