2015-12-30 16:53:16 +00:00
|
|
|
{--
|
|
|
|
HSFM, a filemanager written in Haskell.
|
2016-03-30 22:28:23 +00:00
|
|
|
Copyright (C) 2016 Julian Ospald
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or
|
|
|
|
modify it under the terms of the GNU General Public License
|
|
|
|
version 2 as published by the Free Software Foundation.
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
|
|
along with this program; if not, write to the Free Software
|
|
|
|
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
|
--}
|
|
|
|
|
|
|
|
|
2016-04-04 22:56:36 +00:00
|
|
|
|
2016-03-30 18:16:34 +00:00
|
|
|
module HSFM.GUI.Gtk.MyView where
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
|
|
|
|
import Control.Concurrent.MVar
|
|
|
|
(
|
|
|
|
newEmptyMVar
|
|
|
|
, putMVar
|
|
|
|
, tryTakeMVar
|
|
|
|
)
|
|
|
|
import Control.Concurrent.STM
|
|
|
|
(
|
|
|
|
newTVarIO
|
|
|
|
, readTVarIO
|
|
|
|
)
|
2016-03-31 00:29:16 +00:00
|
|
|
import Control.Exception
|
|
|
|
(
|
|
|
|
try
|
|
|
|
, SomeException
|
|
|
|
)
|
2016-05-09 12:41:57 +00:00
|
|
|
import qualified Data.ByteString as BS
|
2015-12-30 16:53:16 +00:00
|
|
|
import Data.Foldable
|
|
|
|
(
|
|
|
|
for_
|
|
|
|
)
|
|
|
|
import Data.Maybe
|
|
|
|
(
|
|
|
|
catMaybes
|
2016-04-15 12:23:41 +00:00
|
|
|
, fromJust
|
2015-12-30 16:53:16 +00:00
|
|
|
)
|
2016-05-09 14:37:02 +00:00
|
|
|
import HPath.IO.Errors
|
2016-04-19 22:38:22 +00:00
|
|
|
(
|
|
|
|
canOpenDirectory
|
|
|
|
)
|
2015-12-30 16:53:16 +00:00
|
|
|
import Graphics.UI.Gtk
|
2016-04-24 16:38:25 +00:00
|
|
|
import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setViewCallbacks)
|
2016-04-03 02:13:08 +00:00
|
|
|
import HPath
|
|
|
|
(
|
|
|
|
Path
|
|
|
|
, Abs
|
|
|
|
)
|
2016-03-30 00:50:32 +00:00
|
|
|
import qualified HPath as P
|
2016-03-30 18:16:34 +00:00
|
|
|
import HSFM.FileSystem.FileType
|
2016-04-04 22:56:36 +00:00
|
|
|
import HSFM.GUI.Glib.GlibString()
|
2016-03-30 18:16:34 +00:00
|
|
|
import HSFM.GUI.Gtk.Data
|
|
|
|
import HSFM.GUI.Gtk.Icons
|
|
|
|
import HSFM.GUI.Gtk.Utils
|
|
|
|
import HSFM.Utils.IO
|
2016-04-24 16:38:25 +00:00
|
|
|
import Paths_hsfm
|
|
|
|
(
|
|
|
|
getDataFileName
|
|
|
|
)
|
2016-04-15 12:23:41 +00:00
|
|
|
import Prelude hiding(readFile)
|
2016-05-02 17:14:41 +00:00
|
|
|
import System.INotify
|
2015-12-30 16:53:16 +00:00
|
|
|
(
|
|
|
|
addWatch
|
|
|
|
, initINotify
|
|
|
|
, killINotify
|
|
|
|
, EventVariety(..)
|
|
|
|
)
|
2016-05-09 12:41:57 +00:00
|
|
|
import System.Posix.FilePath
|
|
|
|
(
|
|
|
|
pathSeparator
|
2016-05-10 00:05:05 +00:00
|
|
|
, hiddenFile
|
2016-05-09 12:41:57 +00:00
|
|
|
)
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
-- |Creates a new tab with its own view and refreshes the view.
|
|
|
|
newTab :: MyGUI -> IO FMView -> Path Abs -> IO MyView
|
|
|
|
newTab mygui iofmv path = do
|
|
|
|
myview <- createMyView mygui iofmv
|
|
|
|
_ <- notebookAppendPage (notebook mygui) (viewBox myview)
|
|
|
|
(maybe (P.fromAbs path) P.fromRel $ P.basename path)
|
|
|
|
refreshView mygui myview (Just path)
|
|
|
|
return myview
|
|
|
|
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
-- |Constructs the initial MyView object with a few dummy models.
|
|
|
|
-- It also initializes the callbacks.
|
2016-04-15 12:23:41 +00:00
|
|
|
createMyView :: MyGUI
|
|
|
|
-> IO FMView
|
|
|
|
-> IO MyView
|
2015-12-30 16:53:16 +00:00
|
|
|
createMyView mygui iofmv = do
|
|
|
|
inotify <- newEmptyMVar
|
2016-04-19 22:38:22 +00:00
|
|
|
history <- newTVarIO ([],[])
|
2015-12-30 16:53:16 +00:00
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
builder <- builderNew
|
|
|
|
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
|
|
|
|
|
2015-12-30 16:53:16 +00:00
|
|
|
-- create dummy models, so we don't have to use MVar
|
|
|
|
rawModel <- newTVarIO =<< listStoreNew []
|
|
|
|
filteredModel <- newTVarIO =<< (\x -> treeModelFilterNew x [])
|
|
|
|
=<< readTVarIO rawModel
|
|
|
|
sortedModel <- newTVarIO =<< treeModelSortNewWithModel
|
|
|
|
=<< readTVarIO filteredModel
|
2016-04-15 12:23:41 +00:00
|
|
|
cwd <- newEmptyMVar
|
2015-12-30 16:53:16 +00:00
|
|
|
view' <- iofmv
|
|
|
|
view <- newTVarIO view'
|
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
urlBar <- builderGetObject builder castToEntry
|
|
|
|
"urlBar"
|
|
|
|
rcMenu <- builderGetObject builder castToMenu
|
|
|
|
"rcMenu"
|
|
|
|
rcFileOpen <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileOpen"
|
|
|
|
rcFileExecute <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileExecute"
|
|
|
|
rcFileNewRegFile <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileNewRegFile"
|
|
|
|
rcFileNewDir <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileNewDir"
|
|
|
|
rcFileCut <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileCut"
|
|
|
|
rcFileCopy <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileCopy"
|
|
|
|
rcFileRename <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileRename"
|
|
|
|
rcFilePaste <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFilePaste"
|
|
|
|
rcFileDelete <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileDelete"
|
|
|
|
rcFileProperty <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileProperty"
|
|
|
|
rcFileIconView <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileIconView"
|
|
|
|
rcFileTreeView <- builderGetObject builder castToImageMenuItem
|
|
|
|
"rcFileTreeView"
|
|
|
|
upViewB <- builderGetObject builder castToButton
|
|
|
|
"upViewB"
|
|
|
|
homeViewB <- builderGetObject builder castToButton
|
|
|
|
"homeViewB"
|
|
|
|
refreshViewB <- builderGetObject builder castToButton
|
|
|
|
"refreshViewB"
|
|
|
|
scroll <- builderGetObject builder castToScrolledWindow
|
|
|
|
"mainScroll"
|
|
|
|
viewBox <- builderGetObject builder castToBox
|
|
|
|
"viewBox"
|
|
|
|
|
|
|
|
let rcmenu = MkRightClickMenu {..}
|
2015-12-30 16:53:16 +00:00
|
|
|
let myview = MkMyView {..}
|
|
|
|
|
|
|
|
-- set the bindings
|
2016-04-24 16:38:25 +00:00
|
|
|
setViewCallbacks mygui myview
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
-- add the treeview to the scroll container
|
|
|
|
let oview = fmViewToContainer view'
|
2016-04-24 16:38:25 +00:00
|
|
|
containerAdd scroll oview
|
|
|
|
|
|
|
|
widgetShowAll viewBox
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
return myview
|
|
|
|
|
|
|
|
|
|
|
|
-- |Switch the existing view in `MyView` with the one that the
|
|
|
|
-- io action returns.
|
|
|
|
switchView :: MyGUI -> MyView -> IO FMView -> IO ()
|
|
|
|
switchView mygui myview iofmv = do
|
2016-04-24 16:38:25 +00:00
|
|
|
cwd <- getCurrentDir myview
|
2015-12-30 16:53:16 +00:00
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
oldpage <- destroyView mygui myview
|
2015-12-30 16:53:16 +00:00
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
-- create new view and tab page where the previous one was
|
|
|
|
nview <- createMyView mygui iofmv
|
|
|
|
newpage <- notebookInsertPage (notebook mygui) (viewBox nview)
|
|
|
|
(maybe (P.fromAbs $ path cwd) P.fromRel
|
|
|
|
$ P.basename . path $ cwd) oldpage
|
|
|
|
notebookSetCurrentPage (notebook mygui) newpage
|
2015-12-30 16:53:16 +00:00
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
refreshView' mygui nview cwd
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
-- |Destroys the current view by disconnecting the watcher
|
|
|
|
-- and destroying the active FMView container.
|
|
|
|
--
|
|
|
|
-- Everything that needs to be done in order to forget about a
|
|
|
|
-- view needs to be done here.
|
|
|
|
--
|
|
|
|
-- Returns the page in the tab list this view corresponds to.
|
|
|
|
destroyView :: MyGUI -> MyView -> IO Int
|
|
|
|
destroyView mygui myview = do
|
|
|
|
-- disconnect watcher
|
|
|
|
mi <- tryTakeMVar (inotify myview)
|
|
|
|
for_ mi $ \i -> killINotify i
|
2015-12-30 16:53:16 +00:00
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
page <- notebookGetCurrentPage (notebook mygui)
|
|
|
|
|
|
|
|
-- destroy old view and tab page
|
|
|
|
view' <- readTVarIO $ view myview
|
|
|
|
widgetDestroy (fmViewToContainer view')
|
|
|
|
notebookRemovePage (notebook mygui) page
|
|
|
|
|
|
|
|
return page
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Createss an IconView.
|
|
|
|
createIconView :: IO FMView
|
|
|
|
createIconView = do
|
|
|
|
iconv <- iconViewNew
|
|
|
|
iconViewSetSelectionMode iconv SelectionMultiple
|
|
|
|
iconViewSetColumns iconv (-1)
|
|
|
|
iconViewSetSpacing iconv 2
|
|
|
|
iconViewSetMargin iconv 0
|
2016-03-30 00:50:32 +00:00
|
|
|
{- set iconv [ iconViewItemOrientation := OrientationHorizontal ] -}
|
|
|
|
{- set iconv [ iconViewOrientation := OrientationHorizontal ] -}
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
return $ FMIconView iconv
|
|
|
|
|
|
|
|
|
|
|
|
-- |Creates a TreeView.
|
|
|
|
createTreeView :: IO FMView
|
|
|
|
createTreeView = do
|
|
|
|
-- create the final view
|
|
|
|
treeView <- treeViewNew
|
|
|
|
-- set selection mode
|
|
|
|
tvs <- treeViewGetSelection treeView
|
|
|
|
treeSelectionSetMode tvs SelectionMultiple
|
|
|
|
|
2016-04-17 22:51:45 +00:00
|
|
|
-- set drag and drop
|
|
|
|
tl <- targetListNew
|
|
|
|
atom <- atomNew ("HSFM" :: String)
|
|
|
|
targetListAdd tl atom [TargetSameApp] 0
|
|
|
|
treeViewEnableModelDragDest treeView tl [ActionCopy]
|
|
|
|
treeViewEnableModelDragSource treeView [Button1] tl [ActionCopy]
|
|
|
|
|
2015-12-30 16:53:16 +00:00
|
|
|
-- create final tree model columns
|
|
|
|
renderTxt <- cellRendererTextNew
|
|
|
|
renderPix <- cellRendererPixbufNew
|
|
|
|
let ct = cellText :: (CellRendererTextClass cr) => Attr cr String
|
|
|
|
cp = cellPixbuf :: (CellRendererPixbufClass self) => Attr self Pixbuf
|
|
|
|
|
|
|
|
-- filename column
|
|
|
|
cF <- treeViewColumnNew
|
2016-04-04 22:56:36 +00:00
|
|
|
treeViewColumnSetTitle cF ("Filename" :: String)
|
2015-12-30 16:53:16 +00:00
|
|
|
treeViewColumnSetResizable cF True
|
|
|
|
treeViewColumnSetClickable cF True
|
|
|
|
treeViewColumnSetSortColumnId cF 1
|
|
|
|
cellLayoutPackStart cF renderPix False
|
|
|
|
cellLayoutPackStart cF renderTxt True
|
|
|
|
_ <- treeViewAppendColumn treeView cF
|
|
|
|
cellLayoutAddColumnAttribute cF renderPix cp $ makeColumnIdPixbuf 0
|
|
|
|
cellLayoutAddColumnAttribute cF renderTxt ct $ makeColumnIdString 1
|
|
|
|
|
|
|
|
-- date column
|
|
|
|
cMD <- treeViewColumnNew
|
2016-04-04 22:56:36 +00:00
|
|
|
treeViewColumnSetTitle cMD ("Date" :: String)
|
2015-12-30 16:53:16 +00:00
|
|
|
treeViewColumnSetResizable cMD True
|
|
|
|
treeViewColumnSetClickable cMD True
|
|
|
|
treeViewColumnSetSortColumnId cMD 2
|
|
|
|
cellLayoutPackStart cMD renderTxt True
|
|
|
|
_ <- treeViewAppendColumn treeView cMD
|
|
|
|
cellLayoutAddColumnAttribute cMD renderTxt ct $ makeColumnIdString 2
|
|
|
|
|
|
|
|
-- permissions column
|
|
|
|
cP <- treeViewColumnNew
|
2016-04-04 22:56:36 +00:00
|
|
|
treeViewColumnSetTitle cP ("Permission" :: String)
|
2015-12-30 16:53:16 +00:00
|
|
|
treeViewColumnSetResizable cP True
|
|
|
|
treeViewColumnSetClickable cP True
|
|
|
|
treeViewColumnSetSortColumnId cP 3
|
|
|
|
cellLayoutPackStart cP renderTxt True
|
|
|
|
_ <- treeViewAppendColumn treeView cP
|
|
|
|
cellLayoutAddColumnAttribute cP renderTxt ct $ makeColumnIdString 3
|
|
|
|
|
|
|
|
return $ FMTreeView treeView
|
|
|
|
|
|
|
|
|
|
|
|
-- |Re-reads the current directory or the given one and updates the View.
|
2016-04-15 12:23:41 +00:00
|
|
|
-- This is more or less a wrapper around `refreshView'`
|
2016-03-31 00:44:10 +00:00
|
|
|
--
|
|
|
|
-- If the third argument is Nothing, it tries to re-read the current directory.
|
|
|
|
-- If that fails, it reads "/" instead.
|
|
|
|
--
|
|
|
|
-- If the third argument is (Just path) it tries to read "path". If that
|
2016-03-31 00:44:44 +00:00
|
|
|
-- fails, it reads "/" instead.
|
2015-12-30 16:53:16 +00:00
|
|
|
refreshView :: MyGUI
|
|
|
|
-> MyView
|
2016-04-03 02:13:08 +00:00
|
|
|
-> Maybe (Path Abs)
|
2015-12-30 16:53:16 +00:00
|
|
|
-> IO ()
|
|
|
|
refreshView mygui myview mfp =
|
|
|
|
case mfp of
|
|
|
|
Just fp -> do
|
2016-04-19 22:38:22 +00:00
|
|
|
canopen <- canOpenDirectory fp
|
|
|
|
if canopen
|
|
|
|
then refreshView' mygui myview =<< readFile getFileInfo fp
|
|
|
|
else refreshView mygui myview =<< getAlternativeDir
|
2016-03-31 00:29:16 +00:00
|
|
|
Nothing -> refreshView mygui myview =<< getAlternativeDir
|
|
|
|
where
|
|
|
|
getAlternativeDir = do
|
|
|
|
ecd <- try (getCurrentDir myview) :: IO (Either SomeException
|
2016-04-15 12:23:41 +00:00
|
|
|
Item)
|
2016-03-31 14:19:31 +00:00
|
|
|
case ecd of
|
2016-04-16 19:50:15 +00:00
|
|
|
Right dir -> return (Just $ path dir)
|
2016-05-09 12:41:57 +00:00
|
|
|
Left _ -> return (P.parseAbs $ BS.singleton pathSeparator)
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Refreshes the View based on the given directory.
|
2016-03-31 00:44:10 +00:00
|
|
|
--
|
|
|
|
-- If the directory is not a Dir or a Symlink pointing to a Dir, then
|
|
|
|
-- calls `refreshView` with the 3rd argument being Nothing.
|
2015-12-30 16:53:16 +00:00
|
|
|
refreshView' :: MyGUI
|
|
|
|
-> MyView
|
2016-04-15 12:23:41 +00:00
|
|
|
-> Item
|
2015-12-30 16:53:16 +00:00
|
|
|
-> IO ()
|
2016-05-02 20:13:33 +00:00
|
|
|
refreshView' mygui myview SymLink { sdest = d@Dir{} } =
|
|
|
|
refreshView' mygui myview d
|
|
|
|
refreshView' mygui myview item@Dir{} = do
|
2016-04-24 16:38:25 +00:00
|
|
|
newRawModel <- fileListStore item myview
|
2015-12-30 16:53:16 +00:00
|
|
|
writeTVarIO (rawModel myview) newRawModel
|
|
|
|
|
|
|
|
view' <- readTVarIO $ view myview
|
|
|
|
|
2016-04-15 12:23:41 +00:00
|
|
|
_ <- tryTakeMVar (cwd myview)
|
2016-04-24 16:38:25 +00:00
|
|
|
putMVar (cwd myview) item
|
2016-04-15 12:23:41 +00:00
|
|
|
|
2015-12-30 16:53:16 +00:00
|
|
|
-- get selected items
|
|
|
|
tps <- getSelectedTreePaths mygui myview
|
|
|
|
trs <- catMaybes <$> mapM (treeRowReferenceNew newRawModel) tps
|
|
|
|
|
|
|
|
constructView mygui myview
|
|
|
|
|
2016-04-24 16:38:25 +00:00
|
|
|
-- set notebook tab label
|
|
|
|
page <- notebookGetCurrentPage (notebook mygui)
|
|
|
|
child <- fromJust <$> notebookGetNthPage (notebook mygui) page
|
|
|
|
notebookSetTabLabelText (notebook mygui) child
|
|
|
|
(maybe (P.fromAbs $ path item) P.fromRel $ P.basename . path $ item)
|
|
|
|
|
2015-12-30 16:53:16 +00:00
|
|
|
-- reselect selected items
|
|
|
|
-- TODO: not implemented for icon view yet
|
|
|
|
case view' of
|
|
|
|
FMTreeView treeView -> do
|
|
|
|
tvs <- treeViewGetSelection treeView
|
|
|
|
ntps <- mapM treeRowReferenceGetPath trs
|
|
|
|
mapM_ (treeSelectionSelectPath tvs) ntps
|
|
|
|
_ -> return ()
|
2016-04-15 12:23:41 +00:00
|
|
|
refreshView' mygui myview Failed{} = refreshView mygui myview Nothing
|
2015-12-30 16:53:16 +00:00
|
|
|
refreshView' _ _ _ = return ()
|
|
|
|
|
|
|
|
|
|
|
|
-- |Constructs the visible View with the current underlying mutable models,
|
|
|
|
-- which are retrieved from 'MyGUI'.
|
|
|
|
--
|
|
|
|
-- This sort of merges the components mygui and myview and fires up
|
|
|
|
-- the actual models.
|
|
|
|
constructView :: MyGUI
|
|
|
|
-> MyView
|
|
|
|
-> IO ()
|
|
|
|
constructView mygui myview = do
|
2016-03-30 00:50:32 +00:00
|
|
|
settings' <- readTVarIO $ settings mygui
|
|
|
|
|
|
|
|
-- pix stuff
|
|
|
|
iT <- iconThemeGetDefault
|
|
|
|
folderPix <- getIcon IFolder iT (iconSize settings')
|
|
|
|
folderSymPix <- getSymlinkIcon IFolder iT (iconSize settings')
|
|
|
|
filePix <- getIcon IFile iT (iconSize settings')
|
|
|
|
fileSymPix <- getSymlinkIcon IFile iT (iconSize settings')
|
|
|
|
errorPix <- getIcon IError iT (iconSize settings')
|
2016-03-31 14:19:31 +00:00
|
|
|
let dirtreePix Dir{} = folderPix
|
|
|
|
dirtreePix FileLike{} = filePix
|
|
|
|
dirtreePix DirSym{} = folderSymPix
|
|
|
|
dirtreePix FileLikeSym{} = fileSymPix
|
|
|
|
dirtreePix Failed{} = errorPix
|
|
|
|
dirtreePix BrokenSymlink{} = errorPix
|
|
|
|
dirtreePix _ = errorPix
|
2016-03-30 00:50:32 +00:00
|
|
|
|
|
|
|
|
2015-12-30 16:53:16 +00:00
|
|
|
view' <- readTVarIO $ view myview
|
|
|
|
|
2016-04-15 12:23:41 +00:00
|
|
|
cdirp <- path <$> getCurrentDir myview
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
-- update urlBar
|
2016-04-24 16:38:25 +00:00
|
|
|
entrySetText (urlBar myview) (P.fromAbs cdirp)
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
rawModel' <- readTVarIO $ rawModel myview
|
|
|
|
|
|
|
|
-- filtering
|
|
|
|
filteredModel' <- treeModelFilterNew rawModel' []
|
|
|
|
writeTVarIO (filteredModel myview) filteredModel'
|
|
|
|
treeModelFilterSetVisibleFunc filteredModel' $ \iter -> do
|
|
|
|
hidden <- showHidden <$> readTVarIO (settings mygui)
|
2016-04-15 12:23:41 +00:00
|
|
|
item <- treeModelGetRow rawModel' iter >>= (P.basename . path)
|
2015-12-30 16:53:16 +00:00
|
|
|
if hidden
|
|
|
|
then return True
|
2016-05-10 00:05:05 +00:00
|
|
|
else return . not . hiddenFile . P.fromRel $ item
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
-- sorting
|
|
|
|
sortedModel' <- treeModelSortNewWithModel filteredModel'
|
|
|
|
writeTVarIO (sortedModel myview) sortedModel'
|
|
|
|
treeSortableSetSortFunc sortedModel' 1 $ \iter1 iter2 -> do
|
|
|
|
cIter1 <- treeModelFilterConvertIterToChildIter filteredModel' iter1
|
|
|
|
cIter2 <- treeModelFilterConvertIterToChildIter filteredModel' iter2
|
|
|
|
item1 <- treeModelGetRow rawModel' cIter1
|
|
|
|
item2 <- treeModelGetRow rawModel' cIter2
|
|
|
|
return $ compare item1 item2
|
|
|
|
treeSortableSetSortColumnId sortedModel' 1 SortAscending
|
|
|
|
|
|
|
|
-- set values
|
|
|
|
treeModelSetColumn rawModel' (makeColumnIdPixbuf 0)
|
2016-04-15 12:23:41 +00:00
|
|
|
dirtreePix
|
2015-12-30 16:53:16 +00:00
|
|
|
treeModelSetColumn rawModel' (makeColumnIdString 1)
|
2016-04-15 12:23:41 +00:00
|
|
|
(P.toFilePath . fromJust . P.basename . path)
|
2015-12-30 16:53:16 +00:00
|
|
|
treeModelSetColumn rawModel' (makeColumnIdString 2)
|
2016-04-15 12:23:41 +00:00
|
|
|
packModTime
|
2015-12-30 16:53:16 +00:00
|
|
|
treeModelSetColumn rawModel' (makeColumnIdString 3)
|
2016-04-15 12:23:41 +00:00
|
|
|
packPermissions
|
2015-12-30 16:53:16 +00:00
|
|
|
|
|
|
|
-- update model of view
|
|
|
|
case view' of
|
|
|
|
FMTreeView treeView -> do
|
|
|
|
treeViewSetModel treeView sortedModel'
|
|
|
|
treeViewSetRubberBanding treeView True
|
|
|
|
FMIconView iconView -> do
|
|
|
|
iconViewSetModel iconView (Just sortedModel')
|
|
|
|
iconViewSetPixbufColumn iconView
|
|
|
|
(makeColumnIdPixbuf 0 :: ColumnId item Pixbuf)
|
|
|
|
iconViewSetTextColumn iconView
|
|
|
|
(makeColumnIdString 1 :: ColumnId item String)
|
|
|
|
|
|
|
|
-- add watcher
|
|
|
|
mi <- tryTakeMVar (inotify myview)
|
|
|
|
for_ mi $ \i -> killINotify i
|
|
|
|
newi <- initINotify
|
2016-03-31 14:19:31 +00:00
|
|
|
_ <- addWatch
|
2015-12-30 16:53:16 +00:00
|
|
|
newi
|
|
|
|
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
|
2016-03-30 00:50:32 +00:00
|
|
|
(P.fromAbs cdirp)
|
2016-04-19 22:39:53 +00:00
|
|
|
(\_ -> postGUIAsync $ refreshView mygui myview (Just $ cdirp))
|
2015-12-30 16:53:16 +00:00
|
|
|
putMVar (inotify myview) newi
|
|
|
|
|
|
|
|
return ()
|