diff --git a/Manatee/Extension/FileManager/DiredBuffer.hs b/Manatee/Extension/FileManager/DiredBuffer.hs --- a/Manatee/Extension/FileManager/DiredBuffer.hs +++ b/Manatee/Extension/FileManager/DiredBuffer.hs @@ -25,9 +25,9 @@ import Data.ByteString.UTF8 import DBus.Client hiding (Signal) import Data.Ord (comparing) +import Data.List (insert, delete) import Data.Typeable -import Graphics.UI.Gtk.General.Enums -import Graphics.UI.Gtk.ModelView.TreeSortable +import Graphics.UI.Gtk import Manatee.Core.DBus import Manatee.Core.Types import Manatee.Extension.FileManager.PageMode @@ -54,6 +54,7 @@ ,diredBufferFileInfos :: TVar [DiredFileInfo] ,diredBufferSortStatus :: TVar (FileInfoOption, SortType) ,diredBufferIconPixbufDatabase :: TVar FileIconPixbufDatabase + ,diredBufferFileMonitor :: TVar FileMonitor ,diredBufferMode :: PageMode ,diredBufferBroadcastChannel :: TChan DiredBufferSignal } @@ -61,6 +62,7 @@ data DiredBufferSignal = UpdateBuffer FilePath | UpdateView (Maybe String) + | UpdateFile [DiredFileInfo] [DiredFileInfo] deriving (Show, Eq, Ord) data DiredFileInfo = @@ -71,7 +73,7 @@ ,dfiMtimeDescrible :: (GTimeVal, String) ,dfiPermDescrible :: (String, String) } - deriving Show + deriving (Show, Eq, Ord) data FileInfoOption = FIName | FISize | FIMime | FIMTime | FIPermission deriving (Eq, Show, Read) @@ -110,6 +112,9 @@ -- | New. diredBufferNew :: FilePath -> [String] -> Client -> PageId -> CustomizeWrap -> IO DiredBuffer diredBufferNew dir _ client pageId _ = do + -- Create file monitor. + monitor <- fileMonitor (fileFromParseName dir) [] Nothing + -- Create buffer. buffer <- DiredBuffer <$> newTVarIO dir <*> pure client @@ -118,6 +123,7 @@ <*> newTVarIO [] <*> newTVarIO (FIName, SortAscending) <*> newTVarIO M.empty + <*> newTVarIO monitor <*> pure diredMode <*> (newTChanIO :: IO (TChan DiredBufferSignal)) @@ -127,20 +133,25 @@ -- Listen broadcast channel. diredBufferListenChannel buffer + -- Monitor file changed event. + diredBufferHandleFileMonitor buffer + return buffer -- | Listen broadcast channel. diredBufferListenChannel :: DiredBuffer -> IO () -diredBufferListenChannel DiredBuffer {diredBufferClient = client - ,diredBufferPageId = pageId - ,diredBufferMode = mode - ,diredBufferBroadcastChannel = channel - } = +diredBufferListenChannel buffer@(DiredBuffer {diredBufferClient = client + ,diredBufferPageId = pageId + ,diredBufferMode = mode + ,diredBufferBroadcastChannel = channel + }) = listenBufferChannel channel $ \ signal -> case signal of - UpdateBuffer path -> + UpdateBuffer path -> do -- Send SynchronizationPathName signal to daemon process. mkDaemonSignal client SynchronizationPathName (SynchronizationPathNameArgs (pageModeName mode) pageId path) + -- Update file monitor path. + diredBufferUpdateFileMonitorPath buffer path _ -> return () -- | Load. @@ -148,19 +159,18 @@ diredBufferLoad buffer dir = do -- Get file infos. infos <- directoryGetFileInfos (fromString dir) - fileInfos <- diredBufferGenerateFileInfos infos -- Update value. writeTVarIO (diredBufferCurrentDirectory buffer) dir - writeTVarIO (diredBufferFileInfos buffer) fileInfos + writeTVarIOM (diredBufferFileInfos buffer) + (diredBufferGenerateFileInfos infos) forM_ infos $ \info -> modifyTVarIOM (diredBufferIconPixbufDatabase buffer) (updateFileIconPixbufDatabase info) --- | Get file infos. -diredBufferGenerateFileInfos :: [FileInfo] -> IO [DiredFileInfo] -diredBufferGenerateFileInfos infos = - forM infos $ \info -> do +-- | Get file info. +diredBufferGenerateFileInfo :: FileInfo -> IO DiredFileInfo +diredBufferGenerateFileInfo info = do -- Get Type. typeDes <- do let fType = fileInfoGetFileType info @@ -211,6 +221,11 @@ return (permission, permission) return $ DiredFileInfo nameDes typeDes sizeDes mimeDes mtimeDes permissionDes + +-- | Get file infos. +diredBufferGenerateFileInfos :: [FileInfo] -> IO [DiredFileInfo] +diredBufferGenerateFileInfos infos = + forM infos diredBufferGenerateFileInfo -- | Compare file name. diredFileInfoNameCompare :: DiredFileInfo -> DiredFileInfo -> Ordering @@ -220,3 +235,53 @@ fType2 = fst $ dfiTypeDescrible row2 fName1 = fst $ dfiNameDescrible row1 fName2 = fst $ dfiNameDescrible row2 + +-- | Handle file monitor event. +diredBufferHandleFileMonitor :: DiredBuffer -> IO () +diredBufferHandleFileMonitor buffer@(DiredBuffer {diredBufferFileMonitor = fileMonitorTVar}) = do + fm <- readTVarIO fileMonitorTVar + fm `on` fileMonitorChanged $ \ fileSrc _ monitorEvent -> + fileSrc ?>= \file -> + case monitorEvent of + -- Create. + FileMonitorEventCreated -> do + -- Get new add file info. + fileInfo <- fileQueryInfo file "*" [] Nothing + dFileInfo <- diredBufferGenerateFileInfo fileInfo + -- Update new add info. + modifyTVarIO (diredBufferFileInfos buffer) + (insert dFileInfo) + -- Update icon database for new add file. + modifyTVarIOM (diredBufferIconPixbufDatabase buffer) + (updateFileIconPixbufDatabase fileInfo) + -- Send `UpdateFile` signal to broadcast channel. + writeTChanIO (diredBufferBroadcastChannel buffer) + (UpdateFile [dFileInfo] []) + -- Delete. + FileMonitorEventDeleted -> do + -- FIXED: Got runtime user error, here, why? + -- manatee-filemanager: user error (�և�/data/test.txt��� �*���U) + fileInfo <- fileQueryInfo file "*" [] Nothing + dFileInfo <- diredBufferGenerateFileInfo fileInfo + -- Update delete file. + modifyTVarIO (diredBufferFileInfos buffer) + (delete dFileInfo) + -- Send `UpdateFile` signal to broadcast channel. + writeTChanIO (diredBufferBroadcastChannel buffer) + (UpdateFile [] [dFileInfo]) + _ -> + putStrLn ("Uncatch monitor event : " ++ show monitorEvent) + return () + +-- | Update file monitor path. +diredBufferUpdateFileMonitorPath :: DiredBuffer -> FilePath -> IO () +diredBufferUpdateFileMonitorPath buffer@(DiredBuffer {diredBufferFileMonitor = fileMonitorTVar}) + newDir = do + -- Cancel old file monitor. + oldFileMonitor <- readTVarIO fileMonitorTVar + fileMonitorCancel oldFileMonitor + -- Update new file monitor. + writeTVarIOM fileMonitorTVar (fileMonitor (fileFromParseName newDir) [] Nothing) + -- Hook file monitor with new file. + diredBufferHandleFileMonitor buffer + diff --git a/Manatee/Extension/FileManager/DiredView.hs b/Manatee/Extension/FileManager/DiredView.hs --- a/Manatee/Extension/FileManager/DiredView.hs +++ b/Manatee/Extension/FileManager/DiredView.hs @@ -32,6 +32,7 @@ import Graphics.UI.Gtk.Gdk.SerializedEvent import Manatee.Core.DBus import Manatee.Core.FileOpenRule +import Manatee.Core.PageFrame import Manatee.Core.PageView import Manatee.Core.Types import Manatee.Extension.FileManager.DiredBuffer @@ -44,7 +45,6 @@ import Manatee.Toolkit.Gtk.Concurrent import Manatee.Toolkit.Gtk.Gtk import Manatee.Toolkit.Gtk.ModelView -import Manatee.Toolkit.Gtk.ScrolledWindow import Paths_manatee_filemanager import System.FilePath @@ -52,7 +52,7 @@ data DiredView = DiredView {diredViewPlugId :: TVar PagePlugId - ,diredViewScrolledWindow :: ScrolledWindow + ,diredViewFrame :: PageFrame ,diredViewBuffer :: DiredBuffer ,diredViewTreeView :: TreeView ,diredViewListStore :: ListStore DiredFileInfo @@ -71,8 +71,9 @@ instance PageView DiredView where pageViewBuffer = PageBufferWrap . diredViewBuffer pageViewPlugId = diredViewPlugId - pageViewFocus = treeViewFocus . diredViewTreeView + pageViewBox = pageFrameBox . diredViewFrame pageViewScrolledWindow = diredViewScrolledWindow + pageViewFocus = treeViewFocus . diredViewTreeView pageViewHandleKeyAction = diredViewHandleKeyAction pageViewScrollToTop = diredViewScrollToTop pageViewScrollToBottom = diredViewScrollToBottom @@ -86,12 +87,12 @@ pId <- newTVarIO plugId -- Create UI frame. - scrolledWindow <- scrolledWindowNew_ + pFrame <- pageFrameNewWithModeName (pageModeName $ diredBufferMode buffer) -- Tree view. treeView <- treeViewNew treeViewSetEnableTreeLines treeView True - scrolledWindow `containerAdd` treeView + pageFrameAddChild pFrame treeView -- List store. listStore <- listStoreNew [] @@ -103,7 +104,7 @@ channel <- createViewChannel (diredBufferBroadcastChannel buffer) treeView -- Dired view. - let diredView = DiredView pId scrolledWindow buffer treeView listStore sortModel channel + let diredView = DiredView pId pFrame buffer treeView listStore sortModel channel -- Read channel. diredViewListenChannel diredView @@ -131,8 +132,27 @@ -- Or select first file. Nothing -> treeViewFocusFirstToplevelNode (diredViewTreeView view) + UpdateFile addInfos deleteInfos -> do + putStrLn "Got UpdateFile signal." + diredViewUpdateFile view addInfos deleteInfos _ -> return () +-- | Update file information. +diredViewUpdateFile :: DiredView -> [DiredFileInfo] -> [DiredFileInfo] -> IO () +diredViewUpdateFile view addInfos deleteInfos = do + -- Get store. + let store = diredViewListStore view + + -- Delete files. + forM_ deleteInfos $ \deleteItem -> do + list <- listStoreToList (diredViewListStore view) + findIndex (\x -> dfiNameDescrible x == dfiNameDescrible deleteItem) list ?>= \ i -> + listStoreRemove store i + + -- Add files. + forM_ addInfos $ \addItem -> + listStoreAppend store addItem + -- | Entry directory. diredViewEntryDirectory :: DiredView -> FilePath -> Maybe String -> IO () diredViewEntryDirectory view path currentDir = do @@ -147,7 +167,6 @@ -- Get value. let buffer = diredViewBuffer view fileInfos <- readTVarIO $ diredBufferFileInfos buffer - database <- readTVarIO $ diredBufferIconPixbufDatabase buffer let treeView = diredViewTreeView view store = diredViewListStore view model = diredViewSortModel view @@ -163,7 +182,7 @@ treeViewRemoveColumns treeView -- Add icon column. - diredViewAddIconColumn treeView store database + diredViewAddIconColumn treeView store (diredBufferIconPixbufDatabase buffer) -- Add column file info to tree view. forM_ (diredBufferFileInfoOptions buffer) (diredViewAddColumn treeView store model) @@ -175,17 +194,19 @@ return () -- | Add file icon. -diredViewAddIconColumn :: TreeViewClass tv => tv -> ListStore DiredFileInfo -> FileIconPixbufDatabase -> IO () -diredViewAddIconColumn treeView store database = do +diredViewAddIconColumn :: TreeViewClass tv => tv -> ListStore DiredFileInfo -> TVar FileIconPixbufDatabase -> IO () +diredViewAddIconColumn treeView store databaseTVar = do tvc <- treeViewColumnNew set tvc [treeViewColumnTitle := ""] treeViewAppendColumn treeView tvc icon <- cellRendererPixbufNew treeViewColumnPackStart tvc icon True + cellLayoutSetAttributes tvc icon store $ \DiredFileInfo {dfiMimeDescrible = (fMime, _)} -> - [cellPixbuf :=> - return $ maybeError (findIconPixbuf database fMime) + [cellPixbuf :=> do + database <- readTVarIO databaseTVar + return $ maybeError (findIconPixbuf database fMime) ("diredViewAddIconColumn: can't find pixbuf match in database : " ++ show fMime)] -- | Add column. @@ -274,15 +295,15 @@ -- Open file with rule. openRule <- fileOpenRule filePath fileType if null openRule - then pageViewUpdateOutputStatus - view + then pageFrameShowOutputbar + (diredViewFrame view) ("Don't know how to open file : " ++ displayPath) Nothing else do let rule = snd $ head openRule -- use default open rule rule (pageViewClient view) - else pageViewUpdateOutputStatus - view + else pageFrameShowOutputbar + (diredViewFrame view) ("diredViewEntryNode: " ++ displayPath ++ " is not valid filepath.") Nothing @@ -412,3 +433,8 @@ case M.lookup keystoke diredViewKeymap of Just action -> action view Nothing -> widgetPropagateEvent (diredViewTreeView view) sEvent + +-- | Scrolled window. +diredViewScrolledWindow :: DiredView -> ScrolledWindow +diredViewScrolledWindow = + pageFrameScrolledWindow . diredViewFrame diff --git a/manatee-filemanager.cabal b/manatee-filemanager.cabal --- a/manatee-filemanager.cabal +++ b/manatee-filemanager.cabal @@ -1,5 +1,5 @@ name: manatee-filemanager -version: 0.0.7 +version: 0.0.8 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE @@ -30,7 +30,7 @@ location: http://patch-tag.com/r/AndyStewart/manatee-filemanager Library - build-depends: base >= 4 && < 5, manatee-core >= 0.0.7, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0, + build-depends: base >= 4 && < 5, manatee-core >= 0.0.8, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0, containers >= 0.3.0.0, gtk-serialized-event >= 0.12.0, gtk >= 0.12.0, text >= 0.7.1.0, mtl >= 1.1.0.2, old-time >= 1.0.0.3, old-locale >= 1.0.0.2, glib >= 0.12.0, gio >= 0.12.0, filepath >= 1.1.0.3, utf8-string >= 0.3.4