diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index 4e1aa78..97a5a46 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/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 diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs index c5c9a81..71d0b8a 100644 --- a/src/HSFM/GUI/Gtk/MyView.hs +++ b/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 diff --git a/src/HSFM/GUI/Gtk/Utils.hs b/src/HSFM/GUI/Gtk/Utils.hs index 61aaa34..45e7687 100644 --- a/src/HSFM/GUI/Gtk/Utils.hs +++ b/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 +