diff --git a/data/Gtk/builder.xml b/data/Gtk/builder.xml index 2641d18..1be43e9 100644 --- a/data/Gtk/builder.xml +++ b/data/Gtk/builder.xml @@ -1,5 +1,5 @@ - + @@ -361,39 +361,123 @@ - + True - True - True + False - - - - - - - - - - - - - - - - + + True + True + + + True + True + True + + + + + + + + + + + + + + + + + + + + + True + True + + + + + True + True + True + + + + + + + + + + + + + + + + + + + + + True + True + + + + + True + True + 2 + True True - 2 + 1 True False + + + True + True + True + 5 + 5 + 5 + 5 + none + True + + + + + + False + True + 0 + + + + + True + False + 2 + 2 + + + False + True + 1 + + True @@ -410,7 +494,7 @@ True True - 0 + 2 @@ -427,14 +511,48 @@ False True - 1 + 3 + + + + + True + False + 2 + 2 + + + False + True + 4 + + + + + True + True + True + 5 + 5 + 5 + 5 + none + True + + + + + + False + True + 5 False True - 3 + 2 @@ -460,6 +578,16 @@ False gtk-zoom-fit + + True + False + gtk-add + + + True + False + utilities-terminal + True False @@ -567,7 +695,6 @@ Rename True False - image1 False @@ -638,140 +765,146 @@ - + True False - gtk-add + gtk-yes - + True False - utilities-terminal + gtk-yes True False vertical - + True False - + True - True - True + False - + True - False - gtk-go-back + True + True + + + True + False + gtk-go-back + + + + False + True + 2 + 0 + + + + + True + True + True + + + True + False + gtk-go-up + + + + + False + True + 2 + 1 + + + + + True + True + True + + + True + False + gtk-go-forward + + + + + False + True + 2 + 2 + + + + + True + True + True + + + True + False + gtk-refresh + + + + + False + True + 2 + 3 + + + + + True + True + True + + + True + False + gtk-home + + + + + False + True + 4 + + + + + True + True + url + + + True + True + 5 + - - False - True - 2 - 0 - - - - - True - True - True - - - True - False - gtk-go-up - - - - - False - True - 2 - 1 - - - - - True - True - True - - - True - False - gtk-go-forward - - - - - False - True - 2 - 2 - - - - - True - True - True - - - True - False - gtk-refresh - - - - - False - True - 2 - 3 - - - - - True - True - True - - - True - False - gtk-home - - - - - False - True - 4 - - - - - True - True - url - - - True - True - 5 - False True - 0 + 1 @@ -788,7 +921,7 @@ True True - 1 + 2 diff --git a/src/HSFM/GUI/Gtk.hs b/src/HSFM/GUI/Gtk.hs index 894dcf4..419f019 100644 --- a/src/HSFM/GUI/Gtk.hs +++ b/src/HSFM/GUI/Gtk.hs @@ -57,7 +57,8 @@ main = do _ <- initGUI mygui <- createMyGUI - _ <- newTab mygui createTreeView file (-1) + _ <- newTab mygui (notebook1 mygui) createTreeView file (-1) + _ <- newTab mygui (notebook2 mygui) createTreeView file (-1) setGUICallbacks mygui diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index d39024b..fd99f55 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/src/HSFM/GUI/Gtk/Callbacks.hs @@ -121,6 +121,18 @@ import Paths_hsfm setGUICallbacks :: MyGUI -> IO () setGUICallbacks mygui = do + -- notebook toggle buttons + _ <- leftNbBtn mygui `on` toggled $ do + isPressed <- toggleButtonGetActive $ leftNbBtn mygui + if isPressed then widgetShow $ notebook1 mygui + else widgetHide $ notebook1 mygui + + _ <- rightNbBtn mygui `on` toggled $ do + isPressed <- toggleButtonGetActive $ rightNbBtn mygui + if isPressed then widgetShow $ notebook2 mygui + else widgetHide $ notebook2 mygui + + -- statusbar _ <- clearStatusBar mygui `on` buttonActivated $ do popStatusbar mygui writeTVarIO (operationBuffer mygui) None @@ -192,6 +204,16 @@ setViewCallbacks mygui myview = do commonGuiEvents fmv = do let view = fmViewToContainer fmv + -- focus events + _ <- notebook1 mygui `on` setFocusChild $ \w -> + case w of + Nothing -> widgetSetSensitive (leftNbIcon mygui) False + _ -> widgetSetSensitive (leftNbIcon mygui) True + _ <- notebook2 mygui `on` setFocusChild $ \w -> + case w of + Nothing -> widgetSetSensitive (rightNbIcon mygui) False + _ -> widgetSetSensitive (rightNbIcon mygui) True + -- GUI events _ <- backViewB myview `on` buttonPressEvent $ do eb <- eventButton @@ -315,7 +337,7 @@ setViewCallbacks mygui myview = do -- if the item under the cursor is not within the current -- selection (Just item) -> do - liftIO $ opeInNewTab mygui item + liftIO $ opeInNewTab mygui myview item return True -- no item under the cursor, pass on the signal Nothing -> return False @@ -358,21 +380,23 @@ openTerminalHere myview = do -- |Closes the current tab, but only if there is more than one tab. closeTab :: MyGUI -> MyView -> IO () -closeTab mygui myview = do - n <- notebookGetNPages (notebook mygui) - when (n > 1) $ void $ destroyView mygui myview +closeTab _ myview = do + n <- notebookGetNPages (notebook myview) + when (n > 1) $ void $ destroyView myview newTab' :: MyGUI -> MyView -> IO () newTab' mygui myview = do cwd <- getCurrentDir myview - void $ withErrorDialog $ newTab mygui createTreeView cwd (-1) + void $ withErrorDialog + $ newTab mygui (notebook myview) createTreeView cwd (-1) -opeInNewTab :: MyGUI -> Item -> IO () -opeInNewTab mygui item@(DirOrSym _) = - void $ withErrorDialog $ newTab mygui createTreeView item (-1) -opeInNewTab _ _ = return () +opeInNewTab :: MyGUI -> MyView -> Item -> IO () +opeInNewTab mygui myview item@(DirOrSym _) = + void $ withErrorDialog + $ newTab mygui (notebook myview) createTreeView item (-1) +opeInNewTab _ _ _ = return () @@ -532,10 +556,10 @@ open [item] mygui myview = withErrorDialog $ goDir True mygui myview nv r -> void $ openFile . path $ r -open items mygui _ = do +open items mygui myview = do let dirs = filter (fst . sdir) items files = filter (fst . sfileLike) items - forM_ dirs (withErrorDialog . opeInNewTab mygui) + forM_ dirs (withErrorDialog . opeInNewTab mygui myview) forM_ files (withErrorDialog . openFile . path) diff --git a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs b/src/HSFM/GUI/Gtk/Callbacks/Utils.hs index 800bccc..0fa7fcb 100644 --- a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs +++ b/src/HSFM/GUI/Gtk/Callbacks/Utils.hs @@ -115,12 +115,12 @@ goDir bhis mygui myview item = do refreshView mygui myview item -- set notebook tab label - page <- notebookGetCurrentPage (notebook mygui) - child <- fromJust <$> notebookGetNthPage (notebook mygui) page + page <- notebookGetCurrentPage (notebook myview) + child <- fromJust <$> notebookGetNthPage (notebook myview) page -- get the label ebox <- (castToEventBox . fromJust) - <$> notebookGetTabLabel (notebook mygui) child + <$> notebookGetTabLabel (notebook myview) child label <- (castToLabel . head) <$> containerGetChildren ebox -- set the label diff --git a/src/HSFM/GUI/Gtk/Data.hs b/src/HSFM/GUI/Gtk/Data.hs index 1b5167b..d2d30a4 100644 --- a/src/HSFM/GUI/Gtk/Data.hs +++ b/src/HSFM/GUI/Gtk/Data.hs @@ -57,7 +57,14 @@ data MyGUI = MkMyGUI { , menubar :: !MenuBar , statusBar :: !Statusbar , clearStatusBar :: !Button - , notebook :: !Notebook + + , notebook1 :: !Notebook + , leftNbBtn :: !ToggleButton + , leftNbIcon :: !Image + + , notebook2 :: !Notebook + , rightNbBtn :: !ToggleButton + , rightNbIcon :: !Image -- other , fprop :: !FilePropertyGrid @@ -76,6 +83,7 @@ data MyView = MkMyView { , sortedModel :: !(TVar (TypedTreeModelSort Item)) , filteredModel :: !(TVar (TypedTreeModelFilter Item)) , inotify :: !(MVar INotify) + , notebook :: !Notebook -- current notebook -- the first part of the tuple represents the "go back" -- the second part the "go forth" in the history diff --git a/src/HSFM/GUI/Gtk/MyGUI.hs b/src/HSFM/GUI/Gtk/MyGUI.hs index 8a7c4f6..e15553b 100644 --- a/src/HSFM/GUI/Gtk/MyGUI.hs +++ b/src/HSFM/GUI/Gtk/MyGUI.hs @@ -81,12 +81,32 @@ createMyGUI = do "fpropPermEntry" fpropLDEntry <- builderGetObject builder castToEntry "fpropLDEntry" - notebook <- builderGetObject builder castToNotebook - "notebook" + notebook1 <- builderGetObject builder castToNotebook + "notebook1" + notebook2 <- builderGetObject builder castToNotebook + "notebook2" + leftNbIcon <- builderGetObject builder castToImage + "leftNbIcon" + rightNbIcon <- builderGetObject builder castToImage + "rightNbIcon" + leftNbBtn <- builderGetObject builder castToToggleButton + "leftNbBtn" + rightNbBtn <- builderGetObject builder castToToggleButton + "rightNbBtn" + -- this is required so that hotkeys work as expected, because -- we then can connect to signals from `viewBox` more reliably - widgetSetCanFocus notebook False + widgetSetCanFocus notebook1 False + widgetSetCanFocus notebook2 False + + -- notebook toggle buttons + buttonSetImage leftNbBtn leftNbIcon + buttonSetImage rightNbBtn rightNbIcon + widgetSetSensitive leftNbIcon False + widgetSetSensitive rightNbIcon False + toggleButtonSetActive leftNbBtn True + toggleButtonSetActive rightNbBtn True -- construct the gui object let menubar = MkMenuBar {..} diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs index ddd4c9e..d9e029f 100644 --- a/src/HSFM/GUI/Gtk/MyView.hs +++ b/src/HSFM/GUI/Gtk/MyView.hs @@ -92,8 +92,8 @@ 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 +newTab :: MyGUI -> Notebook -> IO FMView -> Item -> Int -> IO MyView +newTab mygui nb iofmv item pos = do -- create eventbox with label @@ -104,8 +104,8 @@ newTab mygui iofmv item pos = do containerAdd ebox label widgetShowAll label - myview <- createMyView mygui iofmv - _ <- notebookInsertPageMenu (notebook mygui) (viewBox myview) + myview <- createMyView mygui nb iofmv + _ <- notebookInsertPageMenu (notebook myview) (viewBox myview) ebox ebox pos -- set initial history @@ -113,7 +113,7 @@ newTab mygui iofmv item pos = do putMVar (history myview) (BrowsingHistory [] (path item) [] historySize) - notebookSetTabReorderable (notebook mygui) (viewBox myview) True + notebookSetTabReorderable (notebook myview) (viewBox myview) True catchIOError (refreshView mygui myview item) $ \e -> do file <- readFile getFileInfo . fromJust . P.parseAbs . fromString @@ -127,8 +127,8 @@ newTab mygui iofmv item pos = do eb <- eventButton case eb of MiddleButton -> liftIO $ do - n <- notebookGetNPages (notebook mygui) - when (n > 1) $ void $ destroyView mygui myview + n <- notebookGetNPages (notebook myview) + when (n > 1) $ void $ destroyView myview return True _ -> return False @@ -138,9 +138,10 @@ newTab mygui iofmv item pos = do -- |Constructs the initial MyView object with a few dummy models. -- It also initializes the callbacks. createMyView :: MyGUI + -> Notebook -> IO FMView -> IO MyView -createMyView mygui iofmv = do +createMyView mygui nb iofmv = do inotify <- newEmptyMVar history <- newEmptyMVar @@ -175,6 +176,7 @@ createMyView mygui iofmv = do viewBox <- builderGetObject builder castToBox "viewBox" + let notebook = nb let myview = MkMyView {..} -- set the bindings @@ -195,13 +197,15 @@ switchView :: MyGUI -> MyView -> IO FMView -> IO () switchView mygui myview iofmv = do cwd <- getCurrentDir myview - oldpage <- destroyView mygui myview + let nb = notebook myview + + oldpage <- destroyView myview -- create new view and tab page where the previous one was - nview <- newTab mygui iofmv cwd oldpage + nview <- newTab mygui nb iofmv cwd oldpage - page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox nview) - notebookSetCurrentPage (notebook mygui) page + page <- fromJust <$> notebookPageNum nb (viewBox nview) + notebookSetCurrentPage nb page refreshView mygui nview cwd @@ -213,18 +217,18 @@ switchView mygui myview iofmv = do -- view needs to be done here. -- -- Returns the page in the tab list this view corresponds to. -destroyView :: MyGUI -> MyView -> IO Int -destroyView mygui myview = do +destroyView :: MyView -> IO Int +destroyView myview = do -- disconnect watcher mi <- tryTakeMVar (inotify myview) for_ mi $ \i -> killINotify i - page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox myview) + page <- fromJust <$> notebookPageNum (notebook myview) (viewBox myview) -- destroy old view and tab page view' <- readTVarIO $ view myview widgetDestroy (fmViewToContainer view') - notebookRemovePage (notebook mygui) page + notebookRemovePage (notebook myview) page return page