GTK: refactor plugins to allow filtering the items

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -17,6 +17,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 module HSFM.GUI.Gtk.Callbacks where
@@ -76,6 +77,7 @@ import HSFM.GUI.Gtk.Callbacks.Utils
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
+import HSFM.GUI.Gtk.Plugins
 import HSFM.GUI.Gtk.Settings
 import HSFM.GUI.Gtk.Utils
 import HSFM.History
@@ -97,7 +99,10 @@ import Control.Concurrent.MVar
   , readMVar
   , takeMVar
   )
-
+import Paths_hsfm
+  (
+    getDataFileName
+  )
 
 
 
@@ -284,8 +289,7 @@ setViewCallbacks mygui myview = do
         t  <- eventTime
         case eb of
           RightButton -> do
-              _ <- liftIO $ menuPopup (rcMenu . rcmenu $ myview)
+              _ <- liftIO $ showPopup mygui myview t
-                          $ Just (RightButton, t)
               -- this is just to not screw with current selection
               -- on right-click
               -- TODO: this misbehaves under IconView
@@ -325,37 +329,7 @@ setViewCallbacks mygui myview = do
           -- not right-click, so pass on the signal
           _ -> return False
 
-      -- right click menu
-      _ <- (rcFileOpen . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview open
-      _ <- (rcFileExecute . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview execute
-      _ <- (rcFileNewRegFile . rcmenu) myview `on` menuItemActivated $
-        liftIO $ newFile mygui myview
-      _ <- (rcFileNewDir . rcmenu) myview `on` menuItemActivated $
-        liftIO $ newDir mygui myview
-      _ <- (rcFileNewTab . rcmenu) myview `on` menuItemActivated $
-        liftIO $ newTab' mygui myview
-      _ <- (rcFileNewTerm . rcmenu) myview `on` menuItemActivated $
-        liftIO $ void $ openTerminalHere myview
-      _ <- (rcFileCopy . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview copyInit
-      _ <- (rcFileRename . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview renameF
-      _ <- (rcFilePaste . rcmenu) myview `on` menuItemActivated $
-        liftIO $ operationFinal mygui myview Nothing
-      _ <- (rcFileDelete . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview del
-      _ <- (rcFileProperty . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview showFilePropertyDialog
-      _ <- (rcFileCut . rcmenu) myview `on` menuItemActivated $
-        liftIO $ withItems mygui myview moveInit
-      _ <- (rcFileIconView . rcmenu) myview `on` menuItemActivated $
-        liftIO $ switchView mygui myview createIconView
-      _ <- (rcFileTreeView . rcmenu) myview `on` menuItemActivated $
-        liftIO $ switchView mygui myview createTreeView
       return ()
-
     getPathAtPos fmv (x, y) =
       case fmv of
         FMTreeView treeView -> do
@@ -627,3 +601,105 @@ mkHistoryMenuF mygui myview hs = do
   widgetShowAll menu
   return menu
 
+
+
+
+---- RIGHTCLICK CALLBACKS ----
+
+
+-- |TODO: hopefully this does not leak
+showPopup :: MyGUI -> MyView -> TimeStamp -> IO ()
+showPopup mygui myview t
+  | null myplugins = return ()
+  | otherwise = do
+
+    rcmenu <- doRcMenu
+
+    -- add common callbacks
+    _ <- (\_ -> rcFileOpen rcmenu) myview `on` menuItemActivated $
+      liftIO $ withItems mygui myview open
+    _ <- (rcFileExecute rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview execute
+    _ <- (rcFileNewRegFile rcmenu) `on` menuItemActivated $
+      liftIO $ newFile mygui myview
+    _ <- (rcFileNewDir rcmenu) `on` menuItemActivated $
+      liftIO $ newDir mygui myview
+    _ <- (rcFileNewTab rcmenu) `on` menuItemActivated $
+      liftIO $ newTab' mygui myview
+    _ <- (rcFileNewTerm rcmenu) `on` menuItemActivated $
+      liftIO $ void $ openTerminalHere myview
+    _ <- (rcFileCopy rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview copyInit
+    _ <- (rcFileRename rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview renameF
+    _ <- (rcFilePaste rcmenu) `on` menuItemActivated $
+      liftIO $ operationFinal mygui myview Nothing
+    _ <- (rcFileDelete rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview del
+    _ <- (rcFileProperty rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview showFilePropertyDialog
+    _ <- (rcFileCut rcmenu) `on` menuItemActivated $
+      liftIO $ withItems mygui myview moveInit
+    _ <- (rcFileIconView rcmenu) `on` menuItemActivated $
+      liftIO $ switchView mygui myview createIconView
+    _ <- (rcFileTreeView rcmenu) `on` menuItemActivated $
+      liftIO $ switchView mygui myview createTreeView
+
+
+    -- add another plugin separator after the existing one
+    -- where we want to place our plugins
+    sep2 <- separatorMenuItemNew
+    widgetShow sep2
+
+    menuShellInsert (rcMenu rcmenu) sep2 insertPos
+
+    plugins <- forM myplugins $ \(ma, mb, mc) -> fmap (, mb, mc) ma
+    -- need to reverse plugins list so the order is right
+    forM_ (reverse plugins) $ \(plugin, filter', cb) -> do
+      showItem <- withItems mygui myview filter'
+
+      menuShellInsert (rcMenu rcmenu) plugin insertPos
+      when showItem $ widgetShow plugin
+      -- init callback
+      plugin `on` menuItemActivated $ withItems mygui myview cb
+
+    menuPopup (rcMenu rcmenu) $ Just (RightButton, t)
+  where
+    doRcMenu = do
+      builder <- builderNew
+      builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
+
+      -- create static right-click menu
+      rcMenu            <- builderGetObject builder castToMenu
+                           (fromString "rcMenu")
+      rcFileOpen        <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileOpen")
+      rcFileExecute     <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileExecute")
+      rcFileNewRegFile  <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewRegFile")
+      rcFileNewDir      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewDir")
+      rcFileNewTab      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewTab")
+      rcFileNewTerm     <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileNewTerm")
+      rcFileCut         <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileCut")
+      rcFileCopy        <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileCopy")
+      rcFileRename      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileRename")
+      rcFilePaste       <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFilePaste")
+      rcFileDelete      <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileDelete")
+      rcFileProperty    <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileProperty")
+      rcFileIconView    <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileIconView")
+      rcFileTreeView    <- builderGetObject builder castToImageMenuItem
+                           (fromString "rcFileTreeView")
+
+      return $ MkRightClickMenu {..}
+

src/HSFM/GUI/Gtk/Data.hs

@@ -84,7 +84,6 @@ data MyView = MkMyView {
   -- sub-widgets
   , scroll       :: !ScrolledWindow
   , viewBox      :: !Box
-  , rcmenu       :: !RightClickMenu
   , backViewB    :: !Button
   , upViewB      :: !Button
   , forwardViewB :: !Button

src/HSFM/GUI/Gtk/MyView.hs

@@ -208,8 +208,6 @@ createMyView mygui iofmv = do
   let rcmenu = MkRightClickMenu {..}
   let myview = MkMyView {..}
 
-  addPlugins mygui myview
-
   -- set the bindings
   setViewCallbacks mygui myview
 

src/HSFM/GUI/Gtk/Plugins.hs

@@ -17,7 +17,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
 
-{-# LANGUAGE TupleSections #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 
@@ -51,42 +50,13 @@ import qualified Data.ByteString as BS
 
 
 
+
     ---------------
     --[ Plugins ]--
     ---------------
 
 
 
----- Init functions ----
-
-
--- |Usually, you don't want to overwrite this method. It
--- adds plugins from `myplugins` and initializes the callbacks
--- automatically.
-addPlugins :: MyGUI -> MyView -> IO ()
-addPlugins mygui myview
-  | null myplugins = return ()
-  | otherwise = do
-    -- add another plugin separator after the existing one
-    -- where we want to place our plugins
-    sep2 <- separatorMenuItemNew
-    widgetShow sep2
-
-    menuShellInsert (rcMenu . rcmenu $ myview) sep2 insertPos
-
-    plugins <- forM myplugins $ \(ma,mb) -> fmap (,mb) ma
-    -- need to reverse plugins list so the order is right
-    forM_ (reverse plugins) $ \(plugin, cb) -> do
-      menuShellInsert (rcMenu . rcmenu $ myview) plugin insertPos
-      widgetShow plugin
-      -- init callback
-      plugin `on` menuItemActivated $ withItems mygui myview cb
-
-    return ()
-
-
-
-
 
 ---- Global settings ----
 
@@ -98,11 +68,19 @@ insertPos = 4
 
 
 -- |A list of plugins to add to the right-click menu at position
--- `insertPos`. The left part of the tuple is the menuitem, the right
+-- `insertPos`.
--- part the callback.
+--
+-- The left part of the triple is the menuitem.
+-- The middle part of the triple is a filter function that
+-- decides whether the item is shown.
+-- The right part of the triple is the callback, which is invoked
+-- when the menu item is clicked.
+--
 -- Plugins are added in order of this list.
-myplugins :: [(IO MenuItem, [Item] -> MyGUI -> MyView -> IO ())]
+myplugins :: [(IO MenuItem
-myplugins = [(diffItem, diffCallback)
+              ,[Item] -> MyGUI -> MyView -> IO Bool
+              ,[Item] -> MyGUI -> MyView -> IO ())]
+myplugins = [(diffItem, diffFilter, diffCallback)
             ]
 
 
@@ -116,6 +94,11 @@ myplugins = [(diffItem, diffCallback)
 diffItem :: IO MenuItem
 diffItem = menuItemNewWithLabel "diff"
 
+diffFilter :: [Item] -> MyGUI -> MyView -> IO Bool
+diffFilter items _ _
+  | length items > 1 = return $ and $ fmap isFileC items
+  | otherwise        = return False
+
 diffCallback :: [Item] -> MyGUI -> MyView -> IO ()
 diffCallback items _ _ = void $
   forkProcess $

src/HSFM/GUI/Gtk/Utils.hs

@@ -78,8 +78,8 @@ withItems :: MyGUI
           -> (   [Item]
               -> MyGUI
               -> MyView
-              -> IO ()) -- ^ action to carry out
+              -> IO a) -- ^ action to carry out
-          -> IO ()
+          -> IO a
 withItems mygui myview io = do
   items <- getSelectedItems mygui myview
   io items mygui myview