GTK: implement selecting multiple rows (and operations on them)

Not all operations yet support it and will throw an InvalidOperation
error in that case.

src/Data/DirTree.hs

@@ -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))
+
+
 
 
     -----------------

src/GUI/Gtk.hs

@@ -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

src/GUI/Gtk/Callbacks.hs

@@ -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
+    liftIO $ withRows mygui myview del
-  _ <- treeView mygui `on` rowActivated $ (\_ _ -> withRow mygui myview open)
+  _ <- 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.
+-- |Supposed to be used with 'withRows'. Opens a file or directory.
-open :: Row -> MyGUI -> MyView -> IO ()
+open :: [Row] -> MyGUI -> MyView -> IO ()
-open row mygui myview = withErrorDialog $
+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 -> IO ()
-execute row mygui myview = withErrorDialog $
+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.
+-- |Supposed to be used with 'withRows'. Deletes a file or directory.
-del :: Row -> MyGUI -> MyView -> IO ()
+del :: [Row] -> MyGUI -> MyView -> IO ()
-del row mygui myview = withErrorDialog $ do
+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 -> IO ()
-moveInit row mygui myview =
+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 'withRows'. Initializes a file copy operation.
--- |Supposed to be used with 'withRow'. Initializes a file copy operation.
 --
 -- Interaction with mutable references:
 --
 -- * 'operationBuffer' writes
-copyInit :: Row -> MyGUI -> MyView -> IO ()
+copyInit :: [Row] -> MyGUI -> MyView -> IO ()
-copyInit row mygui myview =
+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 -> IO ()
-renameF row mygui myview = withErrorDialog $ do
+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"

src/GUI/Gtk/Utils.hs

@@ -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
+                -> MyView
-               -> IO (Maybe Row)
+                -> IO [Row]
-getSelectedRow mygui myview = do
+getSelectedRows mygui myview = do
-  (tp, _)        <- treeViewGetCursor $ treeView mygui
+  tvs   <- treeViewGetSelection (treeView mygui)
-  rawModel'      <- readTVarIO $ rawModel myview
+  tps   <- treeSelectionGetSelectedRows tvs
   sortedModel'   <- readTVarIO $ sortedModel myview
   filteredModel' <- readTVarIO $ filteredModel myview
-  miter          <- treeModelGetIter sortedModel' tp
+  rawModel'      <- readTVarIO $ rawModel myview
-  forM miter $ \iter -> do
+  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
+         -> MyView
-        -> (   Row
+         -> (   [Row]
-            -> MyGUI
+             -> MyGUI
-            -> MyView
+             -> MyView
-            -> IO ()) -- ^ action to carry out
+             -> IO ()) -- ^ action to carry out
-        -> IO ()
+         -> IO ()
-withRow mygui myview io = do
+withRows mygui myview io = do
-  mrow <- getSelectedRow mygui myview
+  rows <- getSelectedRows mygui myview
-  for_ mrow $ \row -> io row mygui myview
+  io rows mygui myview
 
 
 -- |Create the 'ListStore' of files/directories from the current directory.