From 0e226d61ec1e0dc4409e54493e24c4070a5ffaf6 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 9 Apr 2016 16:26:12 +0200
Subject: [PATCH] GTK: fix right-click when multiple files are selected

If the right click happens on an item that is already selected,
don't pass on the signal so the selection which may span across
multiple files is kept.

Otherwise, pass on the signal which means the item under the cursor
will be selected.

This currently misbehaves (as in: doesn't work) with IconView
properly.
---
 src/HSFM/GUI/Gtk/Callbacks.hs | 45 +++++++++++++++++++++++++++--------
 1 file changed, 35 insertions(+), 10 deletions(-)

diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs
index 22e4794..f3fd61c 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs
@@ -76,15 +76,15 @@ setCallbacks :: MyGUI -> MyView -> IO ()
 setCallbacks mygui myview = do
   view' <- readTVarIO $ view myview
   case view' of
-    FMTreeView treeView -> do
+    fmv@(FMTreeView treeView) -> do
       _ <- treeView `on` rowActivated
              $ (\_ _ -> withItems mygui myview open)
-      commonGuiEvents treeView
+      commonGuiEvents fmv
       return ()
-    FMIconView iconView -> do
+    fmv@(FMIconView iconView) -> do
       _ <- iconView `on` itemActivated
              $ (\_ -> withItems mygui myview open)
-      commonGuiEvents iconView
+      commonGuiEvents fmv
       return ()
   menubarCallbacks
   where
@@ -120,7 +120,9 @@ setCallbacks mygui myview = do
       _ <- menubarHelpAbout mygui `on` menuItemActivated $
         liftIO showAboutDialog
       return ()
-    commonGuiEvents view = do
+    commonGuiEvents fmv = do
+      let view = fmViewToContainer fmv
+
       -- GUI events
       _ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
 
@@ -172,10 +174,25 @@ setCallbacks mygui myview = do
         eb <- eventButton
         t  <- eventTime
         case eb of
-          RightButton -> liftIO $ menuPopup (rcMenu mygui)
-            $ Just (RightButton, t)
-          _           -> return ()
-        return False
+          RightButton -> do
+              _ <- liftIO $ menuPopup (rcMenu mygui)
+                          $ Just (RightButton, t)
+              -- this is just to not screw with current selection
+              -- on right-click
+              -- TODO: this misbehaves under IconView
+              (x, y) <- eventCoordinates
+              mpath  <- liftIO $ getPathAtPos fmv (x, y)
+              case mpath of
+                -- item under the cursor, only pass on the signal
+                -- if the item under the cursor is not within the current
+                -- selection
+                (Just tp) -> do
+                  selectedTps <- liftIO $ getSelectedTreePaths mygui myview
+                  return $ elem tp selectedTps
+                -- no item under the cursor, pass on the signal
+                Nothing -> return False
+          -- not right-click, so pass on the signal
+          _ -> return False
       _ <- rcFileOpen mygui `on` menuItemActivated $
         liftIO $ withItems mygui myview open
       _ <- rcFileExecute mygui `on` menuItemActivated $
@@ -192,8 +209,16 @@ setCallbacks mygui myview = do
         liftIO $ withItems mygui myview del
       _ <- rcFileCut mygui `on` menuItemActivated $
         liftIO $ withItems mygui myview moveInit
-
       return ()
+    getPathAtPos fmv (x, y) =
+      case fmv of
+        FMTreeView treeView -> do
+          mp <- treeViewGetPathAtPos treeView (round x, round y)
+          return $ fmap (\(p, _, _) -> p) mp
+        FMIconView iconView ->
+           fmap (\tp -> if null tp then Nothing else Just tp)
+                  $ iconViewGetPathAtPos iconView (round x) (round y)
+
 
 
 -- |Go to the url given at the 'urlBar' and visualize it in the given