GTK: add newTab{,Here} buttons and allow closing tabs via middle-click

This also fixes behavior of destroyView.

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -32,9 +32,10 @@ import Control.Exception
   )
 import Control.Monad
   (
-    forM_
-  , forM
+    forM
+  , forM_
   , join
+  , unless
   , void
   , when
   )
@@ -55,6 +56,10 @@ import Data.Foldable
   (
     for_
   )
+import Data.Maybe
+  (
+    fromJust
+  )
 import Graphics.UI.Gtk
 import qualified HPath as P
 import HPath
@@ -78,6 +83,11 @@ import System.Glib.UTFString
   (
     glibToString
   )
+import System.IO.Error
+  (
+    catchIOError
+  , isUserError
+  )
 import System.Posix.Env.ByteString
   (
     getEnv
@@ -296,6 +306,13 @@ setViewCallbacks mygui myview = do
         liftIO $ newFile mygui myview
       _ <- (rcFileNewDir . rcmenu) myview `on` menuItemActivated $
         liftIO $ newDir mygui myview
+      _ <- (rcFileNewTab . rcmenu) myview `on` menuItemActivated $
+        liftIO $ do
+          cwd <- getCurrentDir myview
+          newTabHere mygui cwd
+      _ <- (rcFileNewTabHere . rcmenu) myview `on` menuItemActivated $
+        liftIO $ withItems mygui myview $ \items mygui' _ ->
+          forM_ items $ newTabHere mygui'
       _ <- (rcFileCopy . rcmenu) myview `on` menuItemActivated $
         liftIO $ withItems mygui myview copyInit
       _ <- (rcFileRename . rcmenu) myview `on` menuItemActivated $
@@ -354,6 +371,42 @@ newTabHere mygui item@(DirOrSym _) =
 newTabHere _ _ = return ()
 
 
+-- |Creates a new tab with its own view and refreshes the view.
+newTab :: MyGUI -> IO FMView -> Item -> IO MyView
+newTab mygui iofmv item = do
+  -- create eventbox with label
+  label <- labelNewWithMnemonic
+    (maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
+  ebox <- eventBoxNew
+  eventBoxSetVisibleWindow ebox False
+  containerAdd ebox label
+  widgetShowAll label
+
+  myview <- createMyView mygui iofmv
+  _ <- notebookAppendPageMenu (notebook mygui) (viewBox myview)
+    ebox ebox
+
+  notebookSetTabReorderable (notebook mygui) (viewBox myview) True
+
+  catchIOError (refreshView mygui myview item) $ \e -> do
+    unless (isUserError e) (ioError e)
+    file <- readFile getFileInfo . fromJust . P.parseAbs . fromString
+      $ "/"
+    refreshView mygui myview file
+    labelSetText label (fromString "/")
+
+  -- close callback
+  _ <- ebox `on` buttonPressEvent $ do
+    eb <- eventButton
+    case eb of
+      MiddleButton -> do
+        _ <- liftIO $ closeTab mygui myview
+        return True
+      _ -> return False
+
+  return myview
+
+
 
 ---- FILE OPERATION CALLBACKS (COPY, MOVE, ...) ----
 

src/HSFM/GUI/Gtk/Callbacks/Utils.hs

@@ -111,6 +111,14 @@ goDir bhis mygui myview item = do
   -- set notebook tab label
   page <- notebookGetCurrentPage (notebook mygui)
   child <- fromJust <$> notebookGetNthPage (notebook mygui) page
-  notebookSetTabLabelText (notebook mygui) child
-       (maybe (P.fromAbs $ path item) P.fromRel $ P.basename . path $ item)
+
+  -- get the label
+  ebox <- (castToEventBox . fromJust)
+    <$> notebookGetTabLabel (notebook mygui) child
+  label <- (castToLabel . head) <$> containerGetChildren ebox
+
+  -- set the label
+  labelSetText label
+    (maybe (P.fromAbs $ path item)
+           P.fromRel $ P.basename . path $ item)
 

src/HSFM/GUI/Gtk/Data.hs

@@ -107,6 +107,8 @@ data RightClickMenu = MkRightClickMenu {
   , rcFileExecute    :: !ImageMenuItem
   , rcFileNewRegFile :: !ImageMenuItem
   , rcFileNewDir     :: !ImageMenuItem
+  , rcFileNewTab     :: !ImageMenuItem
+  , rcFileNewTabHere :: !ImageMenuItem
   , rcFileCut        :: !ImageMenuItem
   , rcFileCopy       :: !ImageMenuItem
   , rcFileRename     :: !ImageMenuItem

src/HSFM/GUI/Gtk/MyView.hs

@@ -32,11 +32,6 @@ import Control.Concurrent.STM
     newTVarIO
   , readTVarIO
   )
-import Control.Monad
-  (
-    forM_
-  , unless
-  )
 import Data.Foldable
   (
     for_
@@ -46,10 +41,6 @@ import Data.Maybe
     catMaybes
   , fromJust
   )
-import Data.String
-  (
-    fromString
-  )
 import Graphics.UI.Gtk
 import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setViewCallbacks)
 import qualified HPath as P
@@ -73,9 +64,7 @@ import System.INotify
   )
 import System.IO.Error
   (
-    catchIOError
-  , ioError
-  , isUserError
+    ioError
   )
 import System.Posix.FilePath
   (
@@ -84,26 +73,6 @@ import System.Posix.FilePath
 
 
 
--- |Creates a new tab with its own view and refreshes the view.
-newTab :: MyGUI -> IO FMView -> Item -> IO MyView
-newTab mygui iofmv item = do
-  myview <- createMyView mygui iofmv
-  i <- notebookAppendPage (notebook mygui) (viewBox myview)
-    (maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
-  mpage <- notebookGetNthPage (notebook mygui) i
-  forM_ mpage $ \page -> notebookSetTabReorderable (notebook mygui)
-                                                   page
-                                                   True
-  catchIOError (refreshView mygui myview item) $ \e -> do
-    forM_ mpage $ \page -> do
-      file <- readFile getFileInfo . fromJust . P.parseAbs . fromString $ "/"
-      refreshView mygui myview file
-      notebookSetTabLabelText (notebook mygui) page "/"
-    unless (isUserError e) (ioError e)
-
-  return myview
-
-
 -- |Constructs the initial MyView object with a few dummy models.
 -- It also initializes the callbacks.
 createMyView :: MyGUI
@@ -138,6 +107,10 @@ createMyView mygui iofmv = do
                        "rcFileNewRegFile"
   rcFileNewDir      <- builderGetObject builder castToImageMenuItem
                        "rcFileNewDir"
+  rcFileNewTab      <- builderGetObject builder castToImageMenuItem
+                       "rcFileNewTab"
+  rcFileNewTabHere  <- builderGetObject builder castToImageMenuItem
+                       "rcFileNewTabHere"
   rcFileCut         <- builderGetObject builder castToImageMenuItem
                        "rcFileCut"
   rcFileCopy        <- builderGetObject builder castToImageMenuItem
@@ -198,7 +171,7 @@ switchView mygui myview iofmv = do
   refreshView mygui nview cwd
 
 
--- |Destroys the current view by disconnecting the watcher
+-- |Destroys the given view by disconnecting the watcher
 -- and destroying the active FMView container.
 --
 -- Everything that needs to be done in order to forget about a
@@ -211,7 +184,7 @@ destroyView mygui myview = do
   mi <- tryTakeMVar (inotify myview)
   for_ mi $ \i -> killINotify i
 
-  page <- notebookGetCurrentPage (notebook mygui)
+  page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox myview)
 
   -- destroy old view and tab page
   view' <- readTVarIO $ view myview