GTK: fix switchView

src/HSFM/GUI/Gtk.hs

@@ -57,7 +57,7 @@ main = do
 
   _ <- initGUI
   mygui <- createMyGUI
-  _ <- newTab mygui createTreeView file
+  _ <- newTab mygui createTreeView file (-1)
 
   setGUICallbacks mygui
 

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -35,7 +35,6 @@ import Control.Monad
     forM
   , forM_
   , join
-  , unless
   , void
   , when
   )
@@ -56,10 +55,6 @@ import Data.Foldable
   (
     for_
   )
-import Data.Maybe
-  (
-    fromJust
-  )
 import Graphics.UI.Gtk
 import qualified HPath as P
 import HPath
@@ -83,11 +78,6 @@ import System.Glib.UTFString
   (
     glibToString
   )
-import System.IO.Error
-  (
-    catchIOError
-  , isUserError
-  )
 import System.Posix.Env.ByteString
   (
     getEnv
@@ -367,44 +357,10 @@ closeTab mygui myview = do
 
 newTabHere :: MyGUI -> Item -> IO ()
 newTabHere mygui item@(DirOrSym _) =
-  void $ withErrorDialog $ newTab mygui createTreeView item
+  void $ withErrorDialog $ newTab mygui createTreeView item (-1)
 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
 
 
 

src/HSFM/GUI/Gtk/MyView.hs

@@ -16,6 +16,7 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
+{-# LANGUAGE RecordWildCards #-}
 
 
 module HSFM.GUI.Gtk.MyView where
@@ -32,6 +33,16 @@ import Control.Concurrent.STM
     newTVarIO
   , readTVarIO
   )
+import Control.Monad
+  (
+    unless
+  , void
+  , when
+  )
+import Control.Monad.IO.Class
+  (
+    liftIO
+  )
 import Data.Foldable
   (
     for_
@@ -41,6 +52,10 @@ 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
@@ -64,7 +79,9 @@ import System.INotify
   )
 import System.IO.Error
   (
-    ioError
+    catchIOError
+  , ioError
+  , isUserError
   )
 import System.Posix.FilePath
   (
@@ -73,6 +90,43 @@ import System.Posix.FilePath
 
 
 
+-- |Creates a new tab with its own view and refreshes the view.
+newTab :: MyGUI -> IO FMView -> Item -> Int -> IO MyView
+newTab mygui iofmv item pos = 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
+  _ <- notebookInsertPageMenu (notebook mygui) (viewBox myview)
+    ebox ebox pos
+
+  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 "/" :: String)
+
+  -- close callback
+  _ <- ebox `on` buttonPressEvent $ do
+    eb <- eventButton
+    case eb of
+      MiddleButton -> liftIO $ do
+        n <- notebookGetNPages (notebook mygui)
+        when (n > 1) $ void $ destroyView mygui myview
+        return True
+      _ -> return False
+
+  return myview
+
+
 -- |Constructs the initial MyView object with a few dummy models.
 -- It also initializes the callbacks.
 createMyView :: MyGUI
@@ -162,11 +216,10 @@ switchView mygui myview iofmv = do
   oldpage <- destroyView mygui myview
 
   -- create new view and tab page where the previous one was
-  nview <- createMyView mygui iofmv
+  nview <- newTab mygui iofmv cwd oldpage
-  newpage <- notebookInsertPage (notebook mygui) (viewBox nview)
+
-             (maybe (P.fromAbs $ path cwd) P.fromRel
+  page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox nview)
-                 $ P.basename . path $ cwd) oldpage
+  notebookSetCurrentPage (notebook mygui) page
-  notebookSetCurrentPage (notebook mygui) newpage
 
   refreshView mygui nview cwd