From e72bff41800ab83c33c540c5e7064d5e9173e6d9 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 3 Jun 2016 14:06:18 +0200 Subject: [PATCH] GTK: fix switchView --- src/HSFM/GUI/Gtk.hs | 2 +- src/HSFM/GUI/Gtk/Callbacks.hs | 46 +------------------------ src/HSFM/GUI/Gtk/MyView.hs | 65 +++++++++++++++++++++++++++++++---- 3 files changed, 61 insertions(+), 52 deletions(-) diff --git a/src/HSFM/GUI/Gtk.hs b/src/HSFM/GUI/Gtk.hs index 18233d0..894dcf4 100644 --- a/src/HSFM/GUI/Gtk.hs +++ b/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 diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index 8e6fda7..de96bf6 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/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 diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs index d491fb4..604f6f1 100644 --- a/src/HSFM/GUI/Gtk/MyView.hs +++ b/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 - newpage <- notebookInsertPage (notebook mygui) (viewBox nview) - (maybe (P.fromAbs $ path cwd) P.fromRel - $ P.basename . path $ cwd) oldpage - notebookSetCurrentPage (notebook mygui) newpage + nview <- newTab mygui iofmv cwd oldpage + + page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox nview) + notebookSetCurrentPage (notebook mygui) page refreshView mygui nview cwd