GTK: implement newTab on middle-click
This commit is contained in:
parent
01c241a01e
commit
9549b40745
@ -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, ...) ----
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user