diff --git a/hsfm.cabal b/hsfm.cabal index 1c28586..20cf914 100644 --- a/hsfm.cabal +++ b/hsfm.cabal @@ -33,6 +33,7 @@ library containers, directory >= 1.1.0.0 && < 1.2.3.0, filepath >= 1.3.0.0, + hinotify, mtl >= 2.2, old-locale >= 1, process, @@ -70,6 +71,7 @@ executable hsfm-gtk bifunctors >= 5, directory >= 1.1.0.0 && < 1.2.3.0, filepath >= 1.3.0.0, + hinotify, mtl >= 2.2, old-locale >= 1, process, diff --git a/src/GUI/Gtk.hs b/src/GUI/Gtk.hs index 43ddb86..dd404c0 100644 --- a/src/GUI/Gtk.hs +++ b/src/GUI/Gtk.hs @@ -29,6 +29,10 @@ import Control.Concurrent ( forkIO ) +import Control.Concurrent.MVar + ( + newEmptyMVar + ) import Control.Concurrent.STM ( TVar @@ -148,6 +152,8 @@ startMainWindow startdir = do settings <- newTVarIO (MkFMSettings False True) + inotify <- newEmptyMVar + -- get the icons iT <- iconThemeGetDefault folderPix <- getIcon IFolder 24 diff --git a/src/GUI/Gtk/Callbacks.hs b/src/GUI/Gtk/Callbacks.hs index 6971c33..6064e8d 100644 --- a/src/GUI/Gtk/Callbacks.hs +++ b/src/GUI/Gtk/Callbacks.hs @@ -206,7 +206,7 @@ del :: Row -> MyGUI -> MyView -> IO () del row mygui myview = withErrorDialog $ do let cmsg = "Really delete \"" ++ fullPath row ++ "\"?" withConfirmationDialog cmsg - $ easyDelete row >> refreshTreeView mygui myview Nothing + $ easyDelete row -- |Initializes a file move operation. @@ -243,16 +243,14 @@ operationFinal mygui myview = withErrorDialog $ do let cmsg = "Really move \"" ++ fullPath s ++ "\"" ++ " to \"" ++ fullPath cdir ++ "\"?" withConfirmationDialog cmsg - (runFileOp (FMove . MC s $ cdir) - >> refreshTreeView mygui myview Nothing) + $ void $ runFileOp (FMove . MC s $ cdir) return () FCopy (CP1 s) -> do let cmsg = "Really copy \"" ++ fullPath s ++ "\"" ++ " to \"" ++ fullPath cdir ++ "\"?" cm <- showCopyModeChooserDialog withConfirmationDialog cmsg - (runFileOp (FCopy . CC s cdir $ cm) - >> refreshTreeView mygui myview Nothing) + $ void $ runFileOp (FCopy . CC s cdir $ cm) return () _ -> return () @@ -279,7 +277,6 @@ newFile mygui myview = withErrorDialog $ do for_ mfn $ \fn -> do cdir <- getCurrentDir myview createFile cdir fn - refreshTreeView' mygui myview cdir renameF :: Row -> MyGUI -> MyView -> IO () @@ -289,5 +286,3 @@ renameF row mygui myview = withErrorDialog $ do let cmsg = "Really rename \"" ++ fullPath row ++ "\"" ++ " to \"" ++ anchor row fn ++ "\"?" withConfirmationDialog cmsg $ IO.File.renameFile row fn - cdir <- getCurrentDir myview - refreshTreeView' mygui myview cdir diff --git a/src/GUI/Gtk/Data.hs b/src/GUI/Gtk/Data.hs index 9d4ad37..c1d364a 100644 --- a/src/GUI/Gtk/Data.hs +++ b/src/GUI/Gtk/Data.hs @@ -21,6 +21,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. module GUI.Gtk.Data where +import Control.Concurrent.MVar + ( + MVar + ) import Control.Concurrent.STM ( TVar @@ -28,7 +32,10 @@ import Control.Concurrent.STM import Data.DirTree import Graphics.UI.Gtk import IO.File - +import System.INotify + ( + INotify + ) @@ -97,5 +104,6 @@ data MyView = MkMyView { , sortedModel :: TVar (TypedTreeModelSort Row) , filteredModel :: TVar (TypedTreeModelFilter Row) , operationBuffer :: TVar FileOperation + , inotify :: MVar INotify } diff --git a/src/GUI/Gtk/Utils.hs b/src/GUI/Gtk/Utils.hs index 78b2692..50c808d 100644 --- a/src/GUI/Gtk/Utils.hs +++ b/src/GUI/Gtk/Utils.hs @@ -25,6 +25,11 @@ import Control.Applicative ( (<$>) ) +import Control.Concurrent.MVar + ( + putMVar + , tryTakeMVar + ) import Control.Concurrent.STM ( TVar @@ -54,6 +59,14 @@ import GUI.Gtk.Data import IO.Error import IO.Utils import MyPrelude +import System.INotify + ( + addWatch + , initINotify + , killINotify + , EventVariety(..) + , Event(..) + ) @@ -149,14 +162,22 @@ refreshTreeView mygui myview mfp = do mcdir <- getFirstRow myview let fp = fromMaybe (anchor mcdir) mfp + -- get selected rows + tvs <- treeViewGetSelection (treeView mygui) + srows <- treeSelectionGetSelectedRows tvs + -- TODO catch exceptions dirSanityThrow fp newFsState <- Data.DirTree.readFile fp newRawModel <- fileListStore newFsState myview writeTVarIO (rawModel myview) newRawModel + constructTreeView mygui myview + -- reselect selected rows + mapM_ (treeSelectionSelectPath tvs) srows + -- |Refreshes the TreeView based on the given directory. -- @@ -170,8 +191,16 @@ refreshTreeView' :: MyGUI refreshTreeView' mygui myview dt = do newRawModel <- fileListStore dt myview writeTVarIO (rawModel myview) newRawModel + + -- get selected rows + tvs <- treeViewGetSelection (treeView mygui) + srows <- treeSelectionGetSelectedRows tvs + constructTreeView mygui myview + -- reselect selected rows + mapM_ (treeSelectionSelectPath tvs) srows + -- TODO: make this function more slim so only the most necessary parts are -- called @@ -189,14 +218,14 @@ constructTreeView :: MyGUI -> IO () constructTreeView mygui myview = do let treeView' = treeView mygui - cF' = cF mygui - cMD' = cMD mygui - render' = renderTxt mygui + cF' = cF mygui + cMD' = cMD mygui + render' = renderTxt mygui - mcdir <- getFirstRow myview + cdirp <- anchor <$> getFirstRow myview -- update urlBar - entrySetText (urlBar mygui) (anchor mcdir) + entrySetText (urlBar mygui) cdirp rawModel' <- readTVarIO $ rawModel myview @@ -234,12 +263,23 @@ constructTreeView mygui myview = do -- update treeview model treeViewSetModel treeView' sortedModel' + -- add watcher + mi <- tryTakeMVar (inotify myview) + for_ mi $ \i -> killINotify i + newi <- initINotify + w <- addWatch + newi + [Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf] + cdirp + (\_ -> postGUIAsync $ refreshTreeView mygui myview (Just cdirp)) + putMVar (inotify myview) newi + return () where dirtreePix (Dir {}) = folderPix mygui dirtreePix (RegFile {}) = filePix mygui dirtreePix (Failed {}) = errorPix mygui - dirtreePix _ = errorPix mygui + dirtreePix _ = errorPix mygui -- |Push a message to the status bar.