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

This also fixes behavior of destroyView.
This commit is contained in:
Julian Ospald 2016-06-03 13:44:59 +02:00
parent 03fbae7999
commit e310879d61
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
5 changed files with 108 additions and 38 deletions

View File

@ -510,6 +510,30 @@
<property name="use_stock">False</property> <property name="use_stock">False</property>
</object> </object>
</child> </child>
<child>
<object class="GtkSeparatorMenuItem" id="separatormenuitem4">
<property name="visible">True</property>
<property name="can_focus">False</property>
</object>
</child>
<child>
<object class="GtkImageMenuItem" id="rcFileNewTab">
<property name="label" translatable="yes">New Tab</property>
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="image">image8</property>
<property name="use_stock">False</property>
</object>
</child>
<child>
<object class="GtkImageMenuItem" id="rcFileNewTabHere">
<property name="label" translatable="yes">New Tab here</property>
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="image">image9</property>
<property name="use_stock">False</property>
</object>
</child>
</object> </object>
</child> </child>
</object> </object>
@ -614,6 +638,16 @@
</object> </object>
</child> </child>
</object> </object>
<object class="GtkImage" id="image8">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="stock">gtk-add</property>
</object>
<object class="GtkImage" id="image9">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="stock">gtk-add</property>
</object>
<object class="GtkBox" id="viewBox"> <object class="GtkBox" id="viewBox">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>

View File

@ -32,9 +32,10 @@ import Control.Exception
) )
import Control.Monad import Control.Monad
( (
forM_ forM
, forM , forM_
, join , join
, unless
, void , void
, when , when
) )
@ -55,6 +56,10 @@ import Data.Foldable
( (
for_ for_
) )
import Data.Maybe
(
fromJust
)
import Graphics.UI.Gtk import Graphics.UI.Gtk
import qualified HPath as P import qualified HPath as P
import HPath import HPath
@ -78,6 +83,11 @@ import System.Glib.UTFString
( (
glibToString glibToString
) )
import System.IO.Error
(
catchIOError
, isUserError
)
import System.Posix.Env.ByteString import System.Posix.Env.ByteString
( (
getEnv getEnv
@ -296,6 +306,13 @@ setViewCallbacks mygui myview = do
liftIO $ newFile mygui myview liftIO $ newFile mygui myview
_ <- (rcFileNewDir . rcmenu) myview `on` menuItemActivated $ _ <- (rcFileNewDir . rcmenu) myview `on` menuItemActivated $
liftIO $ newDir mygui myview 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 $ _ <- (rcFileCopy . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview copyInit liftIO $ withItems mygui myview copyInit
_ <- (rcFileRename . rcmenu) myview `on` menuItemActivated $ _ <- (rcFileRename . rcmenu) myview `on` menuItemActivated $
@ -354,6 +371,42 @@ newTabHere mygui item@(DirOrSym _) =
newTabHere _ _ = return () 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, ...) ---- ---- FILE OPERATION CALLBACKS (COPY, MOVE, ...) ----

View File

@ -111,6 +111,14 @@ goDir bhis mygui myview item = do
-- set notebook tab label -- set notebook tab label
page <- notebookGetCurrentPage (notebook mygui) page <- notebookGetCurrentPage (notebook mygui)
child <- fromJust <$> notebookGetNthPage (notebook mygui) page 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)

View File

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

View File

@ -32,11 +32,6 @@ import Control.Concurrent.STM
newTVarIO newTVarIO
, readTVarIO , readTVarIO
) )
import Control.Monad
(
forM_
, unless
)
import Data.Foldable import Data.Foldable
( (
for_ for_
@ -46,10 +41,6 @@ import Data.Maybe
catMaybes catMaybes
, fromJust , fromJust
) )
import Data.String
(
fromString
)
import Graphics.UI.Gtk import Graphics.UI.Gtk
import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setViewCallbacks) import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setViewCallbacks)
import qualified HPath as P import qualified HPath as P
@ -73,9 +64,7 @@ import System.INotify
) )
import System.IO.Error import System.IO.Error
( (
catchIOError ioError
, ioError
, isUserError
) )
import System.Posix.FilePath 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. -- |Constructs the initial MyView object with a few dummy models.
-- It also initializes the callbacks. -- It also initializes the callbacks.
createMyView :: MyGUI createMyView :: MyGUI
@ -138,6 +107,10 @@ createMyView mygui iofmv = do
"rcFileNewRegFile" "rcFileNewRegFile"
rcFileNewDir <- builderGetObject builder castToImageMenuItem rcFileNewDir <- builderGetObject builder castToImageMenuItem
"rcFileNewDir" "rcFileNewDir"
rcFileNewTab <- builderGetObject builder castToImageMenuItem
"rcFileNewTab"
rcFileNewTabHere <- builderGetObject builder castToImageMenuItem
"rcFileNewTabHere"
rcFileCut <- builderGetObject builder castToImageMenuItem rcFileCut <- builderGetObject builder castToImageMenuItem
"rcFileCut" "rcFileCut"
rcFileCopy <- builderGetObject builder castToImageMenuItem rcFileCopy <- builderGetObject builder castToImageMenuItem
@ -198,7 +171,7 @@ switchView mygui myview iofmv = do
refreshView mygui nview cwd 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. -- and destroying the active FMView container.
-- --
-- Everything that needs to be done in order to forget about a -- Everything that needs to be done in order to forget about a
@ -211,7 +184,7 @@ destroyView mygui myview = do
mi <- tryTakeMVar (inotify myview) mi <- tryTakeMVar (inotify myview)
for_ mi $ \i -> killINotify i for_ mi $ \i -> killINotify i
page <- notebookGetCurrentPage (notebook mygui) page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox myview)
-- destroy old view and tab page -- destroy old view and tab page
view' <- readTVarIO $ view myview view' <- readTVarIO $ view myview