gtk2hs-commit

[Axel S. <si...@co...>]

Tue Sep  2 16:01:27 EDT 2008  A....@ke...
  * Repair general DND functionality on lists.
  
  This patch not only represents some bug fixes, it also adds a few tags that
  make the actual use of DND easier. Some functions such as selectionDataGet
  have changed in order to make them safer. It should be easy now to add
  Clipboards. What needs to be tested is if all functions are there to
  implement DND on normal widgets. An example for this would be quite
  elaborate, hence I have no example yet.

    hunk ./gtk/Graphics/UI/Gtk/Gdk/Enums.chs.pp 68
    --- | Specify the kind of action performed on a drag event.
    +
    +-- | Used in 'Graphics.UI.Gtk.Genearl.Drag.DragContext' to indicate what the
    +-- destination should do with the dropped data.
    +--
    +--   * 'ActionDefault': Initialisation value, should not be used.
    +--
    +--   * 'ActionCopy': Copy the data.
    +--
    +--   * 'ActionMove': Move the data, i.e. first copy it, then delete it from the source.
    +--
    +--   * 'ActionLink':  Add a link to the data. Note that this is only useful if source and
    +--     destination agree on what it means.
    +--
    +--   * 'ActionPrivate': Special action which tells the source that the destination will do
    +--     something that the source doesn't understand.
    +--
    +--   * 'ActionAsk': Ask the user what to do with the data.
    +--
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 24
    --- Type declarations for DND and Selections
    +-- Type declarations for Selections that are used for DND and Clipboards.
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 30
    -  TargetTag(TargetTag),
    -  SelectionTag(SelectionTag),
    -  PropertyTag(PropertyTag),
    +  TargetTag,
    +  SelectionTag,
    +  SelectionTypeTag,
    +  PropertyTag,
    +  Atom(Atom),
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 40
    -  targetTagNew,
    -  selectionTagNew,
    +  tagNew,
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 47
    -import System.Glib.UTFString ( peekUTFString, withUTFString )
    +import System.Glib.UTFString ( readUTFString, withUTFString )
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 57
    --- | A tag that uniquely identifies a target.
    -newtype TargetTag = TargetTag (Ptr ()) deriving Eq
    +-- | A tag that uniquely identifies a selection. A selection denotes the
    +-- exchange mechanism that is being used, for instance, the clipboard is the
    +-- most common exchange mechanism. For drag and drop applications, a new
    +-- selection tag is usually created for each different kind of data that is
    +-- being exchanged.
    +type SelectionTag = Atom
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 64
    -instance Show TargetTag where
    -  show (TargetTag ptr) = atomToString ptr
    +-- | A tag that uniquely identifies a target. A target describes the format of
    +-- the underlying data source, for instance, it might be a string. A single
    +-- selection may support multiple targets: suppose a new target is created for
    +-- the Haskell data type 'Double'. In this case, the value of the floating
    +-- point number could also be offered as a string.
    +type TargetTag = Atom
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 71
    --- | A tag that uniquely identifies a selection.
    -newtype SelectionTag = SelectionTag (Ptr ()) deriving Eq
    +-- | A tag that defines the encoding of the binary data. For instance, a
    +-- string might be encoded as UTF-8 or in a different locale. Each encoding
    +-- would use the same 'TargetTag' but a different 'SelectionTypeTag'.
    +type SelectionTypeTag = Atom
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 76
    -instance Show SelectionTag where
    -  show (SelectionTag ptr) = atomToString ptr
    -
    --- | A tag that uniquely identifies a property of a
    +-- | A tag
    +-- that uniquely identifies a property of a
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 80
    -newtype PropertyTag = PropertyTag (Ptr ()) deriving Eq
    +type PropertyTag = Atom
    +
    +-- | An atom is an index into a global string table. It is possible to
    +-- associate binary data with each entry. This facility is used for
    +-- inter-application data exchange such as properties of
    +-- 'Graphics.UI.Gtk.Gdk.DrawWindow.DrawWindow' (using 'PropertyTag'),
    +-- 'Graphics.UI.Gtk.Clipboard.Clipboard' or 'Graphics.UI.Gtk.General.Drag'
    +-- ('SelectionId' and 'TargetId').
    +newtype Atom = Atom (Ptr ()) deriving Eq
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 90
    -instance Show PropertyTag where
    -  show (PropertyTag ptr) = atomToString ptr
    +instance Show Atom where
    +  show (Atom ptr) = atomToString ptr
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 95
    -	str <- peekUTFString strPtr
    -	{#call unsafe g_free#} (castPtr strPtr)
    -	return str
    +	readUTFString strPtr
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 107
    --- | Create a new 'TargetTag'. Note that creating two target tags with the
    ---   same name will yield two different tags. The name is merely meant to
    ---   ease application development.
    ---
    -targetTagNew :: String -> IO TargetTag
    -targetTagNew name = withUTFString name $ \strPtr ->
    -  liftM TargetTag $ {#call unsafe gdk_atom_intern#} strPtr 0
    -
    --- | Create a new 'SelectionTag'. Note that creating two selection tags with the
    ---   same name will yield two different tags. The name is merely meant to
    ---   ease application development.
    +-- | Create a new 'TargetTag', 'SelectionTag', 'SelectionTypeTag' or
    +--   'PropertyTag'. Note that creating two target tags with the same name will
    +--   create the same tag, in particular, the tag will be the same across
    +--   different applications. Note that the name of an 'Atom' can be printed
    +--   by 'show' though comparing the atom is merely an integer comparison.
    hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 113
    -selectionTagNew :: String -> IO SelectionTag
    -selectionTagNew name = withUTFString name $ \strPtr ->
    -  liftM SelectionTag $ {#call unsafe gdk_atom_intern#} strPtr 0
    +tagNew :: String -> IO Atom
    +tagNew name = withUTFString name $ \strPtr ->
    +  liftM Atom $ {#call unsafe gdk_atom_intern#} strPtr 0
    hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 139
    +import Graphics.UI.Gtk.Gdk.Enums ( DragAction(..) )
    hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 151
    ---------------------
    --- Types
    -
    --- | Used in 'DragContext' to indicate what the destination should do with the
    --- dropped data.
    ---
    --- * 'ActionDefault': Initialisation value, should not be used.
    --- * 'ActionCopy': Copy the data.
    --- * 'ActionMove': Move the data, i.e. first copy it, then delete it from the source using
    ---   the DELETE target of the X selection protocol.
    --- * 'ActionLink':  Add a link to the data. Note that this is only useful if source and
    ---   destination agree on what it means.
    --- * 'ActionPrivate': Special action which tells the source that the destination will do
    ---   something that the source doesn't understand.
    --- * 'ActionAsk': Ask the user what to do with the data.
    -
    -{#enum GdkDragAction as DragAction {underscoreToCase} deriving (Bounded, Eq, Show) #} [_$_]
    -
    -instance Flags DragAction
    hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 230
    -  if ttPtr==nullPtr then return Nothing else return (Just (TargetTag ttPtr))
    +  if ttPtr==nullPtr then return Nothing else return (Just (Atom ttPtr))
    hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 237
    -  if ttPtr==nullPtr then return Nothing else return (Just (TargetTag ttPtr))
    +  if ttPtr==nullPtr then return Nothing else return (Just (Atom ttPtr))
    hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 327
    -dragGetData widget context (TargetTag target) time =
    +dragGetData widget context (Atom target) time =
    hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 151
    --- * 'DestDefaultMotion':   If set for a widget, GTK+, during a drag over this
    +-- * 'DestDefaultMotion': If set for a widget, GTK+, during a drag over this
    hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 155
    --- * 'DestDefaultHighlight':   If set for a widget, GTK+ will draw a
    +--
    +-- * 'DestDefaultHighlight': If set for a widget, GTK+ will draw a
    hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 159
    --- * 'DestDefaultDrop':   If set for a widget, when a drop occurs, GTK+ will
    +--
    +-- * 'DestDefaultDrop': If set for a widget, when a drop occurs, GTK+ will
    hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 167
    +--
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 35
    +  Atom,
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 38
    +  SelectionTypeTag,
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 42
    - [_$_]
    +
    +-- * Constants
    +  targetString,
    +  selectionTypeAtom,
    +  selectionTypeInteger,
    +  selectionTypeString,
    +
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 50
    -  targetTagNew,
    -  selectionTagNew,
    +  tagNew,
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 73
    +  selectionDataGetLength,
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 83
    +  selectionDataGetTarget,
    +  selectionDataSetTarget,
    +  selectionDataGetTargets,
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 106
    +import Graphics.UI.Gtk.General.Structs (
    +  targetString,
    +  selectionTypeAtom,
    +  selectionTypeInteger,
    +  selectionTypeString,
    +  selectionDataGetType)
    +
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 119
    +import Data.Word ( Word32 )
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 133
    -targetListAdd tl (TargetTag tagPtr) flags info = do
    +targetListAdd tl (Atom tagPtr) flags info = do
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 188
    -targetListRemove tl (TargetTag t)= {#call unsafe target_list_remove#} tl t
    +targetListRemove tl (Atom t)= {#call unsafe target_list_remove#} tl t
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 197
    -selectionAddTarget widget (SelectionTag selection) (TargetTag target) info =
    +selectionAddTarget widget (Atom selection) (Atom target) info =
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 208
    -selectionClearTargets widget (SelectionTag selection) =
    +selectionClearTargets widget (Atom selection) =
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 219
    -selectionOwnerSet widget (SelectionTag selection) time =
    +selectionOwnerSet widget (Atom selection) time =
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 227
    --- |
    +-- [_$_]
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 252
    -selectionDataSet :: (Integral a, Storable a) => SelectionTag -> [a] ->
    +selectionDataSet :: (Integral a, Storable a) => SelectionTypeTag -> [a] ->
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 254
    -selectionDataSet (SelectionTag tagPtr) values@(~(v:_)) = ask >>= \selPtr ->
    +selectionDataSet (Atom tagPtr) values@(~(v:_)) = ask >>= \selPtr ->
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 257
    -    (castPtr arrayPtr) (fromIntegral arrayLen)
    +    (castPtr arrayPtr) (fromIntegral (arrayLen*sizeOf v))
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 261
    ---   the size does not match, @Nothing@ is returned.
    +--   the size or the type tag does not match, @Nothing@ is returned.
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 263
    -selectionDataGet :: (Integral a, Storable a) => SelectionDataM (Maybe [a])
    -selectionDataGet = do
    +selectionDataGet :: (Integral a, Storable a) => [_$_]
    +                    SelectionTypeTag -> SelectionDataM (Maybe [a])
    +selectionDataGet tagPtr = do
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 268
    +    typeTag <- selectionDataGetType selPtr
    +    if typeTag/=tagPtr then return Nothing else do
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 271
    -    lenUnits <- {#get SelectionData -> length#} selPtr
    +    lenBytes <- liftM fromIntegral $ {#get SelectionData -> length#} selPtr
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 273
    -    if lenUnits<0 || bitSize/=sizeOf (unsafePerformIO (peek dataPtr))*8
    +    if lenBytes<=0 || bitSize/=sizeOf (unsafePerformIO (peek dataPtr))*8
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 276
    -        peekArray (fromIntegral lenUnits) dataPtr
    -    [_$_]
    +        peekArray (fromIntegral (lenBytes `quot` (bitSize `quot` 8))) dataPtr
    +
    +selectionDataGetLength :: SelectionDataM Int
    +selectionDataGetLength = do
    +  selPtr <- ask
    +  liftIO $ liftM fromIntegral $ {#get SelectionData -> length#} selPtr    [_$_]
    +
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 362
    +-- | 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
    +
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 375
    --- | Queries the content type of the selection by extracting the targets that
    ---   the contained data can be converted into.
    +-- | 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'.
    hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 392
    -      return (map TargetTag targetPtrs)
    +      return (map Atom targetPtrs)
    hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 82
    -  treeSortableDefaultSortColumnId
    +  treeSortableDefaultSortColumnId,
    +  tagInvalid,
    +  selectionPrimary,
    +  selectionSecondary,
    +  selectionClipboard,
    +  targetString,
    +  selectionTypeAtom,
    +  selectionTypeInteger,
    +  selectionTypeString,
    +  selectionDataGetType
    hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 106
    -
    +import Graphics.UI.Gtk.General.DNDTypes (Atom(Atom) , SelectionTag,
    +                                         TargetTag, SelectionTypeTag)
    hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 830
    +
    +intToAtom :: Int -> Atom
    +intToAtom = Atom . plusPtr nullPtr
    +
    +-- | An invalid 'TargetTag', 'SelectionTag', 'SelectionTypeTag' or 'PropertyTag'.
    +--
    +tagInvalid :: Atom
    +tagInvalid = intToAtom #{const GDK_NONE}
    +
    +-- | The primary selection (the currently highlighted text in X11 that can
    +--   in many applications be pasted using the middle button).
    +selectionPrimary :: SelectionTag
    +selectionPrimary = intToAtom #{const GDK_SELECTION_PRIMARY}
    +
    +-- | The secondary selection. Rarely used.
    +selectionSecondary :: SelectionTag
    +selectionSecondary = intToAtom #{const GDK_SELECTION_SECONDARY}
    +
    +-- | The modern clipboard that is filled by copy or cut commands.
    +selectionClipboard :: SelectionTag
    +selectionClipboard = intToAtom #{const GDK_SELECTION_CLIPBOARD}
    +
    +-- | If this target is provided by a selection, then the data is a string.
    +targetString :: TargetTag
    +targetString = intToAtom #{const GDK_TARGET_STRING}
    +
    +-- | The type indicating that the associated data is itself a (list of)
    +-- 'Graphics.UI.Gtk.General.Selection.Atom's.
    +selectionTypeAtom :: SelectionTypeTag
    +selectionTypeAtom = intToAtom #{const GDK_SELECTION_TYPE_ATOM}
    +
    +-- | The type indicating that the associated data consists of integers.
    +selectionTypeInteger :: SelectionTypeTag
    +selectionTypeInteger = intToAtom #{const GDK_SELECTION_TYPE_INTEGER}
    +
    +-- | The type indicating that the associated data is a string without further
    +-- information on its encoding.
    +selectionTypeString :: SelectionTypeTag
    +selectionTypeString = intToAtom #{const GDK_SELECTION_TYPE_STRING}
    +
    +-- | Extract the type field of SelectionData*. This should be in the
    +--   Selection modules but c2hs chokes on the 'type' field.
    +selectionDataGetType :: Ptr () -> IO SelectionTypeTag
    +selectionDataGetType selPtr =
    +  liftM intToAtom $ #{peek GtkSelectionData, type} selPtr
    +
    hunk ./gtk/Graphics/UI/Gtk/ModelView.hs 47
    +  module Graphics.UI.Gtk.ModelView.TreeDrag,
    hunk ./gtk/Graphics/UI/Gtk/ModelView.hs 72
    +import Graphics.UI.Gtk.ModelView.TreeDrag
    hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 34
    -
    +  listStoreNewDND,
    +  [_$_]
    hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 44
    +  listStoreGetSize,
    hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 190
    +-- | Query the number of elements in the store.
    +listStoreGetSize :: ListStore a -> IO Int
    +listStoreGetSize (ListStore model) =
    +  liftM Seq.length $ readIORef (customTreeModelGetPrivate model)
    +  [_$_]
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 42
    --- * Utility functions
    +-- * DND information for exchanging a model and a path.
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 44
    +  targetTreeModelRow,
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 46
    -  treeSetRowDragData
    -
    +  treeSetRowDragData,
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 63
    -import Graphics.UI.Gtk.General.DNDTypes         (SelectionDataM, SelectionData)
    +import Graphics.UI.Gtk.General.DNDTypes         (SelectionDataM, SelectionData,
    +                                                 TargetTag, tagNew)
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 75
    +-- | The 'SelectionTag', 'TargetTag' and 'SelectionTypeTag' of the DND
    +-- mechanism of 'Graphics.UI.Gtk.ModelView.ListStore' and
    +-- 'Graphics.UI.Gtk.ModelView.TreeStore'. This tag is used by
    +-- 'treeGetRowDragData' and 'treeSetRowDragData' to store a store and a
    +-- 'TreePath' in a 'SelectionDataM'. This target should be added to a
    +-- 'Graphics.UI.Gtk.General.Selection.TargetList' using
    +-- 'Graphics.UI.Gtk.General.Seleciton.TargetSameWidget' flag and an
    +-- 'Graphics.UI.Gtk.General.Selection.InfoId' of @0@.
    +--
    +targetTreeModelRow :: TargetTag
    +targetTreeModelRow = unsafePerformIO $ tagNew "GTK_TREE_MODEL_ROW"
    +
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 88
    --- | Obtains a 'TreeModel' and a path from 'SelectionDataM' whenever the target name is
    --- "GTK_TREE_MODEL_ROW". Normally called from a 'treeDragDestDragDataReceived' handler.
    +-- | Obtains a 'TreeModel' and a path from 'SelectionDataM' whenever the target is
    +-- 'targetTreeModelRow'. Normally called from a 'treeDragDestDragDataReceived' handler.
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 104
    --- | Sets selection data with the target name "GTK_TREE_MODEL_ROW", consisting
    +-- | Sets selection data with the target 'targetTreeModelRow', consisting
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 34
    +  treeStoreNewDND,
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 43
    +  treeStoreLookup,
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 554
    -        (Store { depth = d,
    +        (Store { depth = d, -- this might be a space leak
    hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 677
    +
    +-- | Extract a subtree from the current model. Like 'treeStoreGetTree'
    +--   but returns @Nothing@ if the path refers to a non-existant node.
    +--
    +treeStoreLookup :: TreeStore a -> TreePath -> IO (Maybe (Tree a))
    +treeStoreLookup (TreeStore model) path = do
    +  store@Store { depth = d, content = cache } <- [_$_]
    +      readIORef (customTreeModelGetPrivate model)
    +  case fromPath d path of
    +    (Just iter) -> do
    +      let (res, cache') = checkSuccess d iter cache
    +      writeIORef (customTreeModelGetPrivate model) store { content = cache' }
    +      case cache' of
    +        ((_,node:_):_) | res -> return (Just node)
    +        _ -> return Nothing
    +    _ -> return Nothing