GTK: implement selecting multiple rows (and operations on them)
Not all operations yet support it and will throw an InvalidOperation error in that case.
This commit is contained in:
parent
c454fb0b9e
commit
aba62f03f2
@ -361,6 +361,13 @@ pattern FileLikeSym f <- (fileLikeSym -> (True, f))
|
||||
pattern ABrokenSymlink f <- (abrokenSymlink -> (True, f))
|
||||
pattern BrokenSymlink f <- (brokenSymlink -> (True, f))
|
||||
|
||||
pattern DirList fs <- (\fs -> (foldr (&&) True . fmap (fst . sadir) $ fs, fs)
|
||||
-> (True, fs))
|
||||
pattern FileLikeList fs <- (\fs -> (foldr (&&) True
|
||||
. fmap (fst . safileLike)
|
||||
$ fs, fs) -> (True, fs))
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
|
||||
@ -235,6 +235,9 @@ startMainWindow startdir = do
|
||||
|
||||
-- create the final view
|
||||
treeView <- treeViewNew
|
||||
-- set selection mode
|
||||
tvs <- treeViewGetSelection treeView
|
||||
treeSelectionSetMode tvs SelectionMultiple
|
||||
|
||||
-- create final tree model columns
|
||||
renderTxt <- cellRendererTextNew
|
||||
|
||||
@ -32,9 +32,14 @@ import Control.Concurrent.STM
|
||||
, newTVarIO
|
||||
, readTVarIO
|
||||
)
|
||||
import Control.Exception
|
||||
(
|
||||
throw
|
||||
)
|
||||
import Control.Monad
|
||||
(
|
||||
void
|
||||
, forM_
|
||||
)
|
||||
import Control.Monad.IO.Class
|
||||
(
|
||||
@ -49,6 +54,7 @@ import Graphics.UI.Gtk
|
||||
import GUI.Gtk.Data
|
||||
import GUI.Gtk.Dialogs
|
||||
import GUI.Gtk.Utils
|
||||
import IO.Error
|
||||
import IO.File
|
||||
import IO.Utils
|
||||
import System.Directory
|
||||
@ -99,17 +105,20 @@ setCallbacks mygui myview = do
|
||||
liftIO $ upDir mygui myview
|
||||
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
||||
"Delete" <- fmap glibToString eventKeyName
|
||||
liftIO $ withRow mygui myview del
|
||||
_ <- treeView mygui `on` rowActivated $ (\_ _ -> withRow mygui myview open)
|
||||
liftIO $ withRows mygui myview del
|
||||
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
||||
[] <- eventModifier
|
||||
"Return" <- fmap glibToString eventKeyName
|
||||
liftIO $ withRows mygui myview open
|
||||
_ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
|
||||
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
||||
[Control] <- eventModifier
|
||||
"c" <- fmap glibToString eventKeyName
|
||||
liftIO $ withRow mygui myview copyInit
|
||||
liftIO $ withRows mygui myview copyInit
|
||||
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
||||
[Control] <- eventModifier
|
||||
"x" <- fmap glibToString eventKeyName
|
||||
liftIO $ withRow mygui myview moveInit
|
||||
liftIO $ withRows mygui myview moveInit
|
||||
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
|
||||
[Control] <- eventModifier
|
||||
"v" <- fmap glibToString eventKeyName
|
||||
@ -122,23 +131,23 @@ setCallbacks mygui myview = do
|
||||
-- menubar-file
|
||||
_ <- menubarFileQuit mygui `on` menuItemActivated $ mainQuit
|
||||
_ <- menubarFileOpen mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview open
|
||||
liftIO $ withRows mygui myview open
|
||||
_ <- menubarFileExecute mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview execute
|
||||
liftIO $ withRows mygui myview execute
|
||||
_ <- menubarFileNew mygui `on` menuItemActivated $
|
||||
liftIO $ newFile mygui myview
|
||||
|
||||
-- menubar-edit
|
||||
_ <- menubarEditCut mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview moveInit
|
||||
liftIO $ withRows mygui myview moveInit
|
||||
_ <- menubarEditCopy mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview copyInit
|
||||
liftIO $ withRows mygui myview copyInit
|
||||
_ <- menubarEditRename mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview renameF
|
||||
liftIO $ withRows mygui myview renameF
|
||||
_ <- menubarEditPaste mygui `on` menuItemActivated $
|
||||
liftIO $ operationFinal mygui myview
|
||||
_ <- menubarEditDelete mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview del
|
||||
liftIO $ withRows mygui myview del
|
||||
|
||||
-- menubar-help
|
||||
_ <- menubarHelpAbout mygui `on` menuItemActivated $
|
||||
@ -153,21 +162,21 @@ setCallbacks mygui myview = do
|
||||
_ -> return ()
|
||||
return False
|
||||
_ <- rcFileOpen mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview open
|
||||
liftIO $ withRows mygui myview open
|
||||
_ <- rcFileExecute mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview execute
|
||||
liftIO $ withRows mygui myview execute
|
||||
_ <- rcFileNew mygui `on` menuItemActivated $
|
||||
liftIO $ newFile mygui myview
|
||||
_ <- rcFileCopy mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview copyInit
|
||||
liftIO $ withRows mygui myview copyInit
|
||||
_ <- rcFileRename mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview renameF
|
||||
liftIO $ withRows mygui myview renameF
|
||||
_ <- rcFilePaste mygui `on` menuItemActivated $
|
||||
liftIO $ operationFinal mygui myview
|
||||
_ <- rcFileDelete mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview del
|
||||
liftIO $ withRows mygui myview del
|
||||
_ <- rcFileCut mygui `on` menuItemActivated $
|
||||
liftIO $ withRow mygui myview moveInit
|
||||
liftIO $ withRows mygui myview moveInit
|
||||
|
||||
|
||||
return ()
|
||||
@ -184,29 +193,46 @@ urlGoTo mygui myview = withErrorDialog $ do
|
||||
refreshTreeView mygui myview (Just fp)
|
||||
|
||||
|
||||
-- |Supposed to be used with 'withRow'. Opens a file or directory.
|
||||
open :: Row -> MyGUI -> MyView -> IO ()
|
||||
open row mygui myview = withErrorDialog $
|
||||
-- |Supposed to be used with 'withRows'. Opens a file or directory.
|
||||
open :: [Row] -> MyGUI -> MyView -> IO ()
|
||||
open [row] mygui myview = withErrorDialog $
|
||||
case row of
|
||||
ADirOrSym r -> do
|
||||
nv <- Data.DirTree.readFile $ fullPath r
|
||||
refreshTreeView' mygui myview nv
|
||||
r ->
|
||||
void $ openFile r
|
||||
-- this throws on the first error that occurs
|
||||
open (FileLikeList fs) mygui myview = withErrorDialog $
|
||||
forM_ fs $ \f -> void $ openFile f
|
||||
open _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
|
||||
|
||||
-- |Execute a given file.
|
||||
execute :: Row -> MyGUI -> MyView -> IO ()
|
||||
execute row mygui myview = withErrorDialog $
|
||||
execute :: [Row] -> MyGUI -> MyView -> IO ()
|
||||
execute [row] mygui myview = withErrorDialog $
|
||||
void $ executeFile row []
|
||||
execute _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
|
||||
|
||||
-- |Supposed to be used with 'withRow'. Deletes a file or directory.
|
||||
del :: Row -> MyGUI -> MyView -> IO ()
|
||||
del row mygui myview = withErrorDialog $ do
|
||||
-- |Supposed to be used with 'withRows'. Deletes a file or directory.
|
||||
del :: [Row] -> MyGUI -> MyView -> IO ()
|
||||
del [row] mygui myview = withErrorDialog $ do
|
||||
let cmsg = "Really delete \"" ++ fullPath row ++ "\"?"
|
||||
withConfirmationDialog cmsg
|
||||
$ easyDelete row
|
||||
-- this throws on the first error that occurs
|
||||
del rows@(_:_) mygui myview = withErrorDialog $ do
|
||||
let cmsg = "Really delete " ++ show (length rows) ++ " files?"
|
||||
withConfirmationDialog cmsg
|
||||
$ forM_ rows $ \row -> easyDelete row
|
||||
del _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
|
||||
|
||||
-- |Initializes a file move operation.
|
||||
@ -214,19 +240,24 @@ del row mygui myview = withErrorDialog $ do
|
||||
-- Interaction with mutable references:
|
||||
--
|
||||
-- * 'operationBuffer' writes
|
||||
moveInit :: Row -> MyGUI -> MyView -> IO ()
|
||||
moveInit row mygui myview =
|
||||
moveInit :: [Row] -> MyGUI -> MyView -> IO ()
|
||||
moveInit [row] mygui myview =
|
||||
writeTVarIO (operationBuffer myview) (FMove . MP1 $ row)
|
||||
moveInit _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
|
||||
|
||||
-- |Supposed to be used with 'withRow'. Initializes a file copy operation.
|
||||
-- |Supposed to be used with 'withRows'. Initializes a file copy operation.
|
||||
--
|
||||
-- Interaction with mutable references:
|
||||
--
|
||||
-- * 'operationBuffer' writes
|
||||
copyInit :: Row -> MyGUI -> MyView -> IO ()
|
||||
copyInit row mygui myview =
|
||||
copyInit :: [Row] -> MyGUI -> MyView -> IO ()
|
||||
copyInit [row] mygui myview =
|
||||
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ row)
|
||||
copyInit _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
|
||||
|
||||
-- |Finalizes a file operation, such as copy or move.
|
||||
@ -279,10 +310,13 @@ newFile mygui myview = withErrorDialog $ do
|
||||
createFile cdir fn
|
||||
|
||||
|
||||
renameF :: Row -> MyGUI -> MyView -> IO ()
|
||||
renameF row mygui myview = withErrorDialog $ do
|
||||
renameF :: [Row] -> MyGUI -> MyView -> IO ()
|
||||
renameF [row] mygui myview = withErrorDialog $ do
|
||||
mfn <- textInputDialog "Enter new file name"
|
||||
for_ mfn $ \fn -> do
|
||||
let cmsg = "Really rename \"" ++ fullPath row
|
||||
++ "\"" ++ " to \"" ++ anchor row </> fn ++ "\"?"
|
||||
withConfirmationDialog cmsg $ IO.File.renameFile row fn
|
||||
renameF _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
|
||||
@ -47,7 +47,8 @@ import Data.List
|
||||
)
|
||||
import Data.Maybe
|
||||
(
|
||||
fromMaybe
|
||||
catMaybes
|
||||
, fromMaybe
|
||||
, fromJust
|
||||
)
|
||||
import Data.Traversable
|
||||
@ -83,16 +84,17 @@ import System.INotify
|
||||
-- * 'rawModel' reads
|
||||
-- * 'sortedModel' reads
|
||||
-- * 'filteredModel' reads
|
||||
getSelectedRow :: MyGUI
|
||||
getSelectedRows :: MyGUI
|
||||
-> MyView
|
||||
-> IO (Maybe Row)
|
||||
getSelectedRow mygui myview = do
|
||||
(tp, _) <- treeViewGetCursor $ treeView mygui
|
||||
rawModel' <- readTVarIO $ rawModel myview
|
||||
-> IO [Row]
|
||||
getSelectedRows mygui myview = do
|
||||
tvs <- treeViewGetSelection (treeView mygui)
|
||||
tps <- treeSelectionGetSelectedRows tvs
|
||||
sortedModel' <- readTVarIO $ sortedModel myview
|
||||
filteredModel' <- readTVarIO $ filteredModel myview
|
||||
miter <- treeModelGetIter sortedModel' tp
|
||||
forM miter $ \iter -> do
|
||||
rawModel' <- readTVarIO $ rawModel myview
|
||||
iters <- catMaybes <$> mapM (treeModelGetIter sortedModel') tps
|
||||
forM iters $ \iter -> do
|
||||
cIter' <- treeModelSortConvertIterToChildIter sortedModel' iter
|
||||
cIter <- treeModelFilterConvertIterToChildIter filteredModel' cIter'
|
||||
treeModelGetRow rawModel' cIter
|
||||
@ -101,16 +103,16 @@ getSelectedRow mygui myview = do
|
||||
-- |Carry out an action on the currently selected row.
|
||||
--
|
||||
-- If there is no row selected, does nothing.
|
||||
withRow :: MyGUI
|
||||
withRows :: MyGUI
|
||||
-> MyView
|
||||
-> ( Row
|
||||
-> ( [Row]
|
||||
-> MyGUI
|
||||
-> MyView
|
||||
-> IO ()) -- ^ action to carry out
|
||||
-> IO ()
|
||||
withRow mygui myview io = do
|
||||
mrow <- getSelectedRow mygui myview
|
||||
for_ mrow $ \row -> io row mygui myview
|
||||
withRows mygui myview io = do
|
||||
rows <- getSelectedRows mygui myview
|
||||
io rows mygui myview
|
||||
|
||||
|
||||
-- |Create the 'ListStore' of files/directories from the current directory.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user