GTK: implement newTab on middle-click

This commit is contained in:
Julian Ospald 2016-06-01 22:02:18 +02:00
parent 01c241a01e
commit 9549b40745
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 25 additions and 2 deletions

View File

@ -33,6 +33,8 @@ import Control.Exception
import Control.Monad import Control.Monad
( (
forM_ forM_
, forM
, join
, void , void
, when , when
) )
@ -229,7 +231,7 @@ setViewCallbacks mygui myview = do
"t" <- fmap glibToString eventKeyName "t" <- fmap glibToString eventKeyName
liftIO $ void $ do liftIO $ void $ do
cwd <- getCurrentDir myview cwd <- getCurrentDir myview
newTab mygui createTreeView (path cwd) newTabHere mygui cwd
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier [Control] <- eventModifier
"w" <- fmap glibToString eventKeyName "w" <- fmap glibToString eventKeyName
@ -238,7 +240,7 @@ setViewCallbacks mygui myview = do
"F4" <- fmap glibToString eventKeyName "F4" <- fmap glibToString eventKeyName
liftIO $ void $ openTerminalHere myview liftIO $ void $ openTerminalHere myview
-- righ-click -- mouse button click
_ <- view `on` buttonPressEvent $ do _ <- view `on` buttonPressEvent $ do
eb <- eventButton eb <- eventButton
t <- eventTime t <- eventTime
@ -260,6 +262,22 @@ setViewCallbacks mygui myview = do
return $ elem tp selectedTps return $ elem tp selectedTps
-- no item under the cursor, pass on the signal -- no item under the cursor, pass on the signal
Nothing -> return False Nothing -> return False
MiddleButton -> do
(x, y) <- eventCoordinates
mitem <- liftIO $ (getPathAtPos fmv (x, y))
>>= \mpos -> fmap join
$ forM mpos (rawPathToItem myview)
case mitem of
-- item under the cursor, only pass on the signal
-- if the item under the cursor is not within the current
-- selection
(Just item) -> do
liftIO $ newTabHere mygui item
return True
-- no item under the cursor, pass on the signal
Nothing -> return False
OtherButton 8 -> do OtherButton 8 -> do
liftIO $ goHistoryPrev mygui myview liftIO $ goHistoryPrev mygui myview
return False return False
@ -330,6 +348,11 @@ closeTab mygui myview = do
when (n > 1) $ void $ destroyView mygui myview when (n > 1) $ void $ destroyView mygui myview
newTabHere :: MyGUI -> Item -> IO ()
newTabHere mygui item =
void $ newTab mygui createTreeView (path item)
---- FILE OPERATION CALLBACKS (COPY, MOVE, ...) ---- ---- FILE OPERATION CALLBACKS (COPY, MOVE, ...) ----