GTK: implement file drag and drop

Still doesn't work on multiple rows.

Also see #14

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -84,6 +84,36 @@ setCallbacks mygui myview = do
     fmv@(FMTreeView treeView) -> do
       _ <- treeView `on` rowActivated
              $ (\_ _ -> withItems mygui myview open)
+
+      -- drag events
+      _ <- treeView `on` dragBegin $
+        \_ -> withItems mygui myview moveInit
+      _ <- treeView `on` dragDrop $
+         \dc p ts -> do
+           atom  <- atomNew ("HSFM" :: String)
+           p'    <- treeViewConvertWidgetToTreeCoords treeView p
+           mpath <- treeViewGetPathAtPos treeView p'
+           case mpath of
+             Nothing -> do
+               dragFinish dc False False ts
+               return False
+             Just _  -> do
+               dragGetData treeView dc atom ts
+               return True
+      _ <- treeView `on` dragDataReceived $
+        \dc p _ ts ->
+          liftIO $ do
+            signalStopEmission treeView "drag_data_received"
+            p'    <- treeViewConvertWidgetToTreeCoords treeView p
+            mpath <- treeViewGetPathAtPos treeView p'
+            case mpath of
+              Nothing         -> dragFinish dc False False ts
+              Just (tp, _, _) -> do
+                mitem <- rawPathToItem myview tp
+                forM_ mitem $ \item ->
+                  operationFinal mygui myview (Just item)
+                dragFinish dc True False ts
+
       commonGuiEvents fmv
       return ()
     fmv@(FMIconView iconView) -> do
@@ -111,7 +141,7 @@ setCallbacks mygui myview = do
       _ <- menubarEditRename mygui `on` menuItemActivated $
         liftIO $ withItems mygui myview renameF
       _ <- menubarEditPaste mygui `on` menuItemActivated $
-        liftIO $ operationFinal mygui myview
+        liftIO $ operationFinal mygui myview Nothing
       _ <- menubarEditDelete mygui `on` menuItemActivated $
         liftIO $ withItems mygui myview del
 
@@ -176,7 +206,7 @@ setCallbacks mygui myview = do
       _ <- view `on` keyPressEvent $ tryEvent $ do
         [Control] <- eventModifier
         "v"       <- fmap glibToString eventKeyName
-        liftIO $ operationFinal mygui myview
+        liftIO $ operationFinal mygui myview Nothing
 
       -- righ-click
       _ <- view `on` buttonPressEvent $ do
@@ -215,7 +245,7 @@ setCallbacks mygui myview = do
       _ <- rcFileRename mygui `on` menuItemActivated $
         liftIO $ withItems mygui myview renameF
       _ <- rcFilePaste mygui `on` menuItemActivated $
-        liftIO $ operationFinal mygui myview
+        liftIO $ operationFinal mygui myview Nothing
       _ <- rcFileDelete mygui `on` menuItemActivated $
         liftIO $ withItems mygui myview del
       _ <- rcFileCut mygui `on` menuItemActivated $
@@ -321,10 +351,12 @@ copyInit _ _ _ = withErrorDialog
 
 
 -- |Finalizes a file operation, such as copy or move.
-operationFinal :: MyGUI -> MyView -> IO ()
-operationFinal _ myview = withErrorDialog $ do
+operationFinal :: MyGUI -> MyView -> Maybe Item -> IO ()
+operationFinal _ myview mitem = withErrorDialog $ do
   op <- readTVarIO (operationBuffer myview)
-  cdir <- path <$> getCurrentDir myview
+  cdir <- case mitem of
+            Nothing -> path <$> getCurrentDir myview
+            Just x  -> return $ path x
   case op of
     FMove (MP1 s) -> do
       let cmsg = "Really move " ++ imsg s

src/HSFM/GUI/Gtk/MyView.hs

@@ -156,6 +156,13 @@ createTreeView = do
   tvs <- treeViewGetSelection treeView
   treeSelectionSetMode tvs SelectionMultiple
 
+  -- set drag and drop
+  tl <- targetListNew
+  atom <- atomNew ("HSFM" :: String)
+  targetListAdd tl atom [TargetSameApp] 0
+  treeViewEnableModelDragDest treeView tl [ActionCopy]
+  treeViewEnableModelDragSource treeView [Button1] tl [ActionCopy]
+
   -- create final tree model columns
   renderTxt <- cellRendererTextNew
   renderPix <- cellRendererPixbufNew

src/HSFM/GUI/Gtk/Utils.hs

@@ -67,24 +67,7 @@ getSelectedItems :: MyGUI
                  -> IO [Item]
 getSelectedItems mygui myview = do
   tps   <- getSelectedTreePaths mygui myview
-  getSelectedItems' mygui myview tps
-
-
-getSelectedItems' :: MyGUI
-                  -> MyView
-                  -> [TreePath]
-                  -> IO [Item]
-getSelectedItems' _ myview tps = do
-  rawModel'      <- readTVarIO $ rawModel myview
-  sortedModel'   <- readTVarIO $ sortedModel myview
-  filteredModel' <- readTVarIO $ filteredModel myview
-  iters <- catMaybes <$> mapM (treeModelGetIter sortedModel') tps
-  forM iters $ \iter -> do
-    cIter' <- treeModelSortConvertIterToChildIter sortedModel' iter
-    cIter  <- treeModelFilterConvertIterToChildIter filteredModel' cIter'
-    treeModelGetRow rawModel' cIter
-
-
+  catMaybes <$> mapM (rawPathToItem myview) tps
 
 
 -- |Carry out an action on the currently selected item.
@@ -129,8 +112,6 @@ getCurrentDir :: MyView
 getCurrentDir myview = readMVar (cwd myview)
 
 
-
-
 -- |Push a message to the status bar.
 pushStatusBar :: MyGUI -> String -> IO (ContextId, MessageId)
 pushStatusBar mygui str = do
@@ -146,3 +127,25 @@ popStatusbar mygui = do
   let sb = statusBar mygui
   cid <- statusbarGetContextId sb "FM Status"
   statusbarPop sb cid
+
+
+-- |Turn a path on the rawModel into a path that we can
+-- use at the outermost model layer.
+rawPathToIter :: MyView -> TreePath -> IO (Maybe TreeIter)
+rawPathToIter myview tp = do
+  fmodel <- readTVarIO (filteredModel myview)
+  smodel <- readTVarIO (sortedModel myview)
+  msiter <- treeModelGetIter smodel tp
+  forM msiter $ \siter -> do
+    cIter <- treeModelSortConvertIterToChildIter smodel siter
+    treeModelFilterConvertIterToChildIter fmodel cIter
+
+
+-- |Turn a path on the rawModel into the corresponding item
+-- that we can use at the outermost model layer.
+rawPathToItem :: MyView -> TreePath -> IO (Maybe Item)
+rawPathToItem myview tp = do
+  rawModel' <- readTVarIO $ rawModel myview
+  miter     <- rawPathToIter myview tp
+  forM miter $ \iter -> treeModelGetRow rawModel' iter
+