GTK: add IconView and refactor the modules

This commit is contained in:
Julian Ospald 2015-12-30 17:53:16 +01:00
parent 2bc406f65e
commit b266b78e14
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
9 changed files with 706 additions and 618 deletions

View File

@ -99,6 +99,11 @@
<property name="can_focus">False</property>
<property name="stock">gtk-cancel</property>
</object>
<object class="GtkImage" id="image4">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="stock">gtk-zoom-fit</property>
</object>
<object class="GtkApplicationWindow" id="rootWin">
<property name="can_focus">False</property>
<child>
@ -229,8 +234,31 @@
<object class="GtkMenuItem" id="menubarView">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="label" translatable="yes">_View</property>
<property name="use_underline">True</property>
<property name="label" translatable="yes">View</property>
<child type="submenu">
<object class="GtkMenu" id="menu5">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<object class="GtkImageMenuItem" id="menubarViewTree">
<property name="label">Tree View</property>
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="image">image4</property>
<property name="use_stock">False</property>
</object>
</child>
<child>
<object class="GtkImageMenuItem" id="menubarViewIcon">
<property name="label">Icon view</property>
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="image">image5</property>
<property name="use_stock">False</property>
</object>
</child>
</object>
</child>
</object>
</child>
<child>
@ -280,7 +308,7 @@
</packing>
</child>
<child>
<object class="GtkButton" id="refreshView">
<object class="GtkButton" id="refreshViewB">
<property name="label">gtk-refresh</property>
<property name="visible">True</property>
<property name="can_focus">True</property>
@ -368,4 +396,9 @@
</object>
</child>
</object>
<object class="GtkImage" id="image5">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="stock">gtk-zoom-fit</property>
</object>
</interface>

View File

@ -58,6 +58,8 @@ executable hsfm-gtk
GUI.Gtk.Data
GUI.Gtk.Dialogs
GUI.Gtk.Icons
GUI.Gtk.MyGUI
GUI.Gtk.MyView
GUI.Gtk.Utils
MyPrelude

View File

@ -20,74 +20,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module Main where
import Control.Applicative
(
(<$>)
, (<*>)
)
import Control.Concurrent
(
forkIO
)
import Control.Concurrent.MVar
(
newEmptyMVar
)
import Control.Concurrent.STM
(
TVar
, newTVarIO
, readTVarIO
)
import Control.Exception
(
try
, Exception
, SomeException
)
import Control.Monad
(
when
, void
)
import Control.Monad.IO.Class
(
liftIO
)
import Data.DirTree
import Data.Foldable
(
for_
)
import Data.List
(
sort
, isPrefixOf
)
import Data.Maybe
(
fromJust
, catMaybes
, fromMaybe
)
import Data.Traversable
(
forM
)
import Graphics.UI.Gtk
import GUI.Gtk.Callbacks
import GUI.Gtk.Data
import GUI.Gtk.Dialogs
import GUI.Gtk.Icons
import GUI.Gtk.Utils
import IO.Error
import IO.File
import IO.Utils
import MyPrelude
import Paths_hsfm
(
getDataFileName
)
import GUI.Gtk.MyGUI
import GUI.Gtk.MyView
import Safe
(
headDef
@ -96,28 +33,6 @@ import System.Environment
(
getArgs
)
import System.FilePath
(
isAbsolute
, (</>)
)
import System.Glib.UTFString
(
glibToString
)
import System.IO.Unsafe
(
unsafePerformIO
)
import System.Process
(
spawnProcess
)
-- TODO: simplify where we modify the TVars
-- TODO: double check garbage collection/gtk ref counting
-- TODO: file watching, when and what to reread
main :: IO ()
@ -126,172 +41,14 @@ main = do
args <- getArgs
startMainWindow (headDef "/" args)
mygui <- createMyGUI
myview <- createMyView mygui createTreeView
refreshView mygui myview (Just $ headDef "/" args)
widgetShowAll (rootWin mygui)
_ <- mainGUI
return ()
-------------------------
--[ Main Window Setup ]--
-------------------------
-- |Set up the GUI.
--
-- Interaction with mutable references:
--
-- * 'settings' creates
-- * 'operationBuffer' creates
-- * 'rawModel' creates
-- * 'filteredModel' creates
-- * 'sortedModel' creates
startMainWindow :: FilePath -> IO ()
startMainWindow startdir = do
settings <- newTVarIO (MkFMSettings False True)
inotify <- newEmptyMVar
-- get the icons
iT <- iconThemeGetDefault
folderPix <- getIcon IFolder iT 24
folderSymPix <- getSymlinkIcon IFolder iT 24
filePix <- getIcon IFile iT 24
fileSymPix <- getSymlinkIcon IFile iT 24
errorPix <- getIcon IError iT 24
operationBuffer <- newTVarIO None
builder <- builderNew
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
-- get the pre-defined gui widgets
rootWin <- builderGetObject builder castToWindow
"rootWin"
scroll <- builderGetObject builder castToScrolledWindow
"mainScroll"
menubarFileQuit <- builderGetObject builder castToImageMenuItem
"menubarFileQuit"
menubarFileOpen <- builderGetObject builder castToImageMenuItem
"menubarFileOpen"
menubarFileExecute <- builderGetObject builder castToImageMenuItem
"menubarFileExecute"
menubarFileNew <- builderGetObject builder castToImageMenuItem
"menubarFileNew"
menubarEditCut <- builderGetObject builder castToImageMenuItem
"menubarEditCut"
menubarEditCopy <- builderGetObject builder castToImageMenuItem
"menubarEditCopy"
menubarEditRename <- builderGetObject builder castToImageMenuItem
"menubarEditRename"
menubarEditPaste <- builderGetObject builder castToImageMenuItem
"menubarEditPaste"
menubarEditDelete <- builderGetObject builder castToImageMenuItem
"menubarEditDelete"
menubarHelpAbout <- builderGetObject builder castToImageMenuItem
"menubarHelpAbout"
urlBar <- builderGetObject builder castToEntry
"urlBar"
statusBar <- builderGetObject builder castToStatusbar
"statusBar"
clearStatusBar <- builderGetObject builder castToButton
"clearStatusBar"
rcMenu <- builderGetObject builder castToMenu
"rcMenu"
rcFileOpen <- builderGetObject builder castToImageMenuItem
"rcFileOpen"
rcFileExecute <- builderGetObject builder castToImageMenuItem
"rcFileExecute"
rcFileNew <- builderGetObject builder castToImageMenuItem
"rcFileNew"
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"
refreshView <- builderGetObject builder castToButton
"refreshView"
-- create initial list store model with unsorted data
-- we check that the startdir passed by the user is valid
-- TODO: maybe move this to a separate function
sd <- (\x -> if (failed . file $ x) || (not . isAbsolute . anchor $ x)
then Data.DirTree.readFile "/"
else return x) =<< Data.DirTree.readFile startdir
rawModel <- newTVarIO =<< listStoreNew
=<< Data.DirTree.getContents sd
filteredModel <- newTVarIO =<< (\x -> treeModelFilterNew x [])
=<< readTVarIO rawModel
-- create an initial sorting proxy model
sortedModel <- newTVarIO =<< treeModelSortNewWithModel
=<< readTVarIO filteredModel
-- create the final view
treeView <- treeViewNew
-- set selection mode
tvs <- treeViewGetSelection treeView
treeSelectionSetMode tvs SelectionMultiple
-- 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
treeViewColumnSetTitle cF "Filename"
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
treeViewColumnSetTitle cMD "Date"
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
treeViewColumnSetTitle cP "Permission"
treeViewColumnSetResizable cP True
treeViewColumnSetClickable cP True
treeViewColumnSetSortColumnId cP 3
cellLayoutPackStart cP renderTxt True
_ <- treeViewAppendColumn treeView cP
cellLayoutAddColumnAttribute cP renderTxt ct $ makeColumnIdString 3
-- construct the gui object
let mygui = MkMyGUI {..}
let myview = MkMyView {..}
-- create the tree model with its contents
constructTreeView mygui myview
-- set the bindings
setCallbacks mygui myview
-- add the treeview to the scroll container
containerAdd scroll treeView
-- sets the default icon
windowSetDefaultIconFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png"
widgetShowAll rootWin

View File

@ -28,9 +28,7 @@ import Control.Applicative
)
import Control.Concurrent.STM
(
TVar
, newTVarIO
, readTVarIO
readTVarIO
)
import Control.Exception
(
@ -53,6 +51,7 @@ import Data.Foldable
import Graphics.UI.Gtk
import GUI.Gtk.Data
import GUI.Gtk.Dialogs
import GUI.Gtk.MyView
import GUI.Gtk.Utils
import IO.Error
import IO.File
@ -77,109 +76,121 @@ import System.Glib.UTFString
-- |Set callbacks, on hotkeys, events and stuff.
--
-- Interaction with mutable references:
--
-- * 'settings mygui' modifies
setCallbacks :: MyGUI -> MyView -> IO ()
setCallbacks mygui myview = do
-- GUI events
_ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
_ <- treeView mygui `on` rowActivated $ (\_ _ -> withRows mygui myview open)
_ <- refreshView mygui `on` buttonActivated $ do
cdir <- liftIO $ getCurrentDir myview
refreshTreeView' mygui myview cdir
_ <- clearStatusBar mygui `on` buttonActivated $ do
popStatusbar mygui
writeTVarIO (operationBuffer myview) None
view' <- readTVarIO $ view myview
case view' of
FMTreeView treeView -> setTreeViewCallbacks treeView
FMIconView iconView -> return ()
menubarCallbacks
where
menubarCallbacks = do
-- menubar-file
_ <- menubarFileQuit mygui `on` menuItemActivated $ mainQuit
_ <- menubarFileOpen mygui `on` menuItemActivated $
liftIO $ withItems mygui myview open
_ <- menubarFileExecute mygui `on` menuItemActivated $
liftIO $ withItems mygui myview execute
_ <- menubarFileNew mygui `on` menuItemActivated $
liftIO $ newFile mygui myview
-- key events
_ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"q" <- fmap glibToString eventKeyName
liftIO mainQuit
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"h" <- fmap glibToString eventKeyName
cdir <- liftIO $ getCurrentDir myview
liftIO $ modifyTVarIO (settings mygui)
(\x -> x { showHidden = not . showHidden $ x})
>> refreshTreeView' mygui myview cdir
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Up" <- fmap glibToString eventKeyName
liftIO $ upDir mygui myview
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
"Delete" <- fmap glibToString eventKeyName
liftIO $ withRows mygui myview del
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
[] <- eventModifier
"Return" <- fmap glibToString eventKeyName
liftIO $ withRows mygui myview open
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"c" <- fmap glibToString eventKeyName
liftIO $ withRows mygui myview copyInit
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"x" <- fmap glibToString eventKeyName
liftIO $ withRows mygui myview moveInit
_ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"v" <- fmap glibToString eventKeyName
liftIO $ operationFinal mygui myview
-- menubar-edit
_ <- menubarEditCut mygui `on` menuItemActivated $
liftIO $ withItems mygui myview moveInit
_ <- menubarEditCopy mygui `on` menuItemActivated $
liftIO $ withItems mygui myview copyInit
_ <- menubarEditRename mygui `on` menuItemActivated $
liftIO $ withItems mygui myview renameF
_ <- menubarEditPaste mygui `on` menuItemActivated $
liftIO $ operationFinal mygui myview
_ <- menubarEditDelete mygui `on` menuItemActivated $
liftIO $ withItems mygui myview del
-- menubar-file
_ <- menubarFileQuit mygui `on` menuItemActivated $ mainQuit
_ <- menubarFileOpen mygui `on` menuItemActivated $
liftIO $ withRows mygui myview open
_ <- menubarFileExecute mygui `on` menuItemActivated $
liftIO $ withRows mygui myview execute
_ <- menubarFileNew mygui `on` menuItemActivated $
liftIO $ newFile mygui myview
-- mewnubar-view
_ <- menubarViewIcon mygui `on` menuItemActivated $
liftIO $ switchView mygui myview createIconView
_ <- menubarViewTree mygui `on` menuItemActivated $
liftIO $ switchView mygui myview createTreeView
-- menubar-edit
_ <- menubarEditCut mygui `on` menuItemActivated $
liftIO $ withRows mygui myview moveInit
_ <- menubarEditCopy mygui `on` menuItemActivated $
liftIO $ withRows mygui myview copyInit
_ <- menubarEditRename mygui `on` menuItemActivated $
liftIO $ withRows mygui myview renameF
_ <- menubarEditPaste mygui `on` menuItemActivated $
liftIO $ operationFinal mygui myview
_ <- menubarEditDelete mygui `on` menuItemActivated $
liftIO $ withRows mygui myview del
-- menubar-help
_ <- menubarHelpAbout mygui `on` menuItemActivated $
liftIO showAboutDialog
return ()
setTreeViewCallbacks treeView = do
-- GUI events
_ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
_ <- treeView `on` rowActivated
$ (\_ _ -> withItems mygui myview open)
_ <- refreshViewB mygui `on` buttonActivated $ do
cdir <- liftIO $ getCurrentDir myview
refreshView' mygui myview cdir
_ <- clearStatusBar mygui `on` buttonActivated $ do
popStatusbar mygui
writeTVarIO (operationBuffer myview) None
-- menubar-help
_ <- menubarHelpAbout mygui `on` menuItemActivated $
liftIO showAboutDialog
-- key events
_ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"q" <- fmap glibToString eventKeyName
liftIO mainQuit
_ <- treeView `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"h" <- fmap glibToString eventKeyName
cdir <- liftIO $ getCurrentDir myview
liftIO $ modifyTVarIO (settings mygui)
(\x -> x { showHidden = not . showHidden $ x})
>> refreshView' mygui myview cdir
_ <- treeView `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Up" <- fmap glibToString eventKeyName
liftIO $ upDir mygui myview
_ <- treeView `on` keyPressEvent $ tryEvent $ do
"Delete" <- fmap glibToString eventKeyName
liftIO $ withItems mygui myview del
_ <- treeView `on` keyPressEvent $ tryEvent $ do
[] <- eventModifier
"Return" <- fmap glibToString eventKeyName
liftIO $ withItems mygui myview open
_ <- treeView `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"c" <- fmap glibToString eventKeyName
liftIO $ withItems mygui myview copyInit
_ <- treeView `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"x" <- fmap glibToString eventKeyName
liftIO $ withItems mygui myview moveInit
_ <- treeView `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"v" <- fmap glibToString eventKeyName
liftIO $ operationFinal mygui myview
-- righ-click
_ <- treeView mygui `on` buttonPressEvent $ do
eb <- eventButton
t <- eventTime
case eb of
RightButton -> liftIO $ menuPopup (rcMenu mygui) $ Just (RightButton, t)
_ -> return ()
return False
_ <- rcFileOpen mygui `on` menuItemActivated $
liftIO $ withRows mygui myview open
_ <- rcFileExecute mygui `on` menuItemActivated $
liftIO $ withRows mygui myview execute
_ <- rcFileNew mygui `on` menuItemActivated $
liftIO $ newFile mygui myview
_ <- rcFileCopy mygui `on` menuItemActivated $
liftIO $ withRows mygui myview copyInit
_ <- rcFileRename mygui `on` menuItemActivated $
liftIO $ withRows mygui myview renameF
_ <- rcFilePaste mygui `on` menuItemActivated $
liftIO $ operationFinal mygui myview
_ <- rcFileDelete mygui `on` menuItemActivated $
liftIO $ withRows mygui myview del
_ <- rcFileCut mygui `on` menuItemActivated $
liftIO $ withRows mygui myview moveInit
-- righ-click
_ <- treeView `on` buttonPressEvent $ do
eb <- eventButton
t <- eventTime
case eb of
RightButton -> liftIO $ menuPopup (rcMenu mygui)
$ Just (RightButton, t)
_ -> return ()
return False
_ <- rcFileOpen mygui `on` menuItemActivated $
liftIO $ withItems mygui myview open
_ <- rcFileExecute mygui `on` menuItemActivated $
liftIO $ withItems mygui myview execute
_ <- rcFileNew mygui `on` menuItemActivated $
liftIO $ newFile mygui myview
_ <- rcFileCopy mygui `on` menuItemActivated $
liftIO $ withItems mygui myview copyInit
_ <- rcFileRename mygui `on` menuItemActivated $
liftIO $ withItems mygui myview renameF
_ <- rcFilePaste mygui `on` menuItemActivated $
liftIO $ operationFinal mygui myview
_ <- rcFileDelete mygui `on` menuItemActivated $
liftIO $ withItems mygui myview del
_ <- rcFileCut mygui `on` menuItemActivated $
liftIO $ withItems mygui myview moveInit
return ()
return ()
-- |Go to the url given at the 'urlBar' and visualize it in the given
@ -190,16 +201,16 @@ urlGoTo mygui myview = withErrorDialog $ do
let abs = isAbsolute fp
exists <- (||) <$> doesDirectoryExist fp <*> doesFileExist fp
-- TODO: more explicit error handling?
refreshTreeView mygui myview (Just fp)
refreshView mygui myview (Just fp)
-- |Supposed to be used with 'withRows'. Opens a file or directory.
open :: [Row] -> MyGUI -> MyView -> IO ()
open [row] mygui myview = withErrorDialog $
case row of
open :: [Item] -> MyGUI -> MyView -> IO ()
open [item] mygui myview = withErrorDialog $
case item of
ADirOrSym r -> do
nv <- Data.DirTree.readFile $ fullPath r
refreshTreeView' mygui myview nv
refreshView' mygui myview nv
r ->
void $ openFile r
-- this throws on the first error that occurs
@ -211,39 +222,35 @@ open _ _ _ = withErrorDialog
-- |Execute a given file.
execute :: [Row] -> MyGUI -> MyView -> IO ()
execute [row] mygui myview = withErrorDialog $
void $ executeFile row []
execute :: [Item] -> MyGUI -> MyView -> IO ()
execute [item] mygui myview = withErrorDialog $
void $ executeFile item []
execute _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
-- |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 ++ "\"?"
del :: [Item] -> MyGUI -> MyView -> IO ()
del [item] mygui myview = withErrorDialog $ do
let cmsg = "Really delete \"" ++ fullPath item ++ "\"?"
withConfirmationDialog cmsg
$ easyDelete row
$ easyDelete item
-- this throws on the first error that occurs
del rows@(_:_) mygui myview = withErrorDialog $ do
let cmsg = "Really delete " ++ show (length rows) ++ " files?"
del items@(_:_) mygui myview = withErrorDialog $ do
let cmsg = "Really delete " ++ show (length items) ++ " files?"
withConfirmationDialog cmsg
$ forM_ rows $ \row -> easyDelete row
$ forM_ items $ \item -> easyDelete item
del _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
-- |Initializes a file move operation.
--
-- Interaction with mutable references:
--
-- * 'operationBuffer' writes
moveInit :: [Row] -> MyGUI -> MyView -> IO ()
moveInit [row] mygui myview = do
writeTVarIO (operationBuffer myview) (FMove . MP1 $ row)
let sbmsg = "Move buffer: " ++ fullPath row
moveInit :: [Item] -> MyGUI -> MyView -> IO ()
moveInit [item] mygui myview = do
writeTVarIO (operationBuffer myview) (FMove . MP1 $ item)
let sbmsg = "Move buffer: " ++ fullPath item
popStatusbar mygui
void $ pushStatusBar mygui sbmsg
moveInit _ _ _ = withErrorDialog
@ -251,14 +258,10 @@ moveInit _ _ _ = withErrorDialog
"Operation not supported on multiple files"
-- |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 = do
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ row)
let sbmsg = "Copy buffer: " ++ fullPath row
copyInit :: [Item] -> MyGUI -> MyView -> IO ()
copyInit [item] mygui myview = do
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ item)
let sbmsg = "Copy buffer: " ++ fullPath item
popStatusbar mygui
void $ pushStatusBar mygui sbmsg
copyInit _ _ _ = withErrorDialog
@ -267,10 +270,6 @@ copyInit _ _ _ = withErrorDialog
-- |Finalizes a file operation, such as copy or move.
--
-- Interaction with mutable references:
--
-- * 'operationBuffer' reads
operationFinal :: MyGUI -> MyView -> IO ()
operationFinal mygui myview = withErrorDialog $ do
op <- readTVarIO (operationBuffer myview)
@ -292,18 +291,13 @@ operationFinal mygui myview = withErrorDialog $ do
-- |Go up one directory and visualize it in the treeView.
--
-- Interaction with mutable references:
--
-- * 'rawModel' reads
-- * 'sortedModel' reads
upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = withErrorDialog $ do
cdir <- getCurrentDir myview
rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview
nv <- goUp cdir
refreshTreeView' mygui myview nv
refreshView' mygui myview nv
-- |Go up one directory and visualize it in the treeView.
@ -315,13 +309,13 @@ newFile mygui myview = withErrorDialog $ do
createFile cdir fn
renameF :: [Row] -> MyGUI -> MyView -> IO ()
renameF [row] mygui myview = withErrorDialog $ do
renameF :: [Item] -> MyGUI -> MyView -> IO ()
renameF [item] 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
let cmsg = "Really rename \"" ++ fullPath item
++ "\"" ++ " to \"" ++ anchor item </> fn ++ "\"?"
withConfirmationDialog cmsg $ IO.File.renameFile item fn
renameF _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"

View File

@ -0,0 +1,25 @@
{--
HSFM, a filemanager written in Haskell.
Copyright (C) 2015 Julian Ospald
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.
--}
module GUI.Gtk.Callbacks where
import GUI.Gtk.Data
setCallbacks :: MyGUI -> MyView -> IO ()

View File

@ -60,6 +60,8 @@ data MyGUI = MkMyGUI {
, menubarEditRename :: ImageMenuItem
, menubarEditPaste :: ImageMenuItem
, menubarEditDelete :: ImageMenuItem
, menubarViewTree :: ImageMenuItem
, menubarViewIcon :: ImageMenuItem
, menubarHelpAbout :: ImageMenuItem
, rcMenu :: Menu
, rcFileOpen :: ImageMenuItem
@ -70,23 +72,17 @@ data MyGUI = MkMyGUI {
, rcFileRename :: ImageMenuItem
, rcFilePaste :: ImageMenuItem
, rcFileDelete :: ImageMenuItem
, refreshView :: Button
, refreshViewB :: Button
, urlBar :: Entry
, statusBar :: Statusbar
, clearStatusBar :: Button
, treeView :: TreeView
-- |first column
, cF :: TreeViewColumn
-- |second column
, cMD :: TreeViewColumn
, renderTxt :: CellRendererText
, renderPix :: CellRendererPixbuf
, settings :: TVar FMSettings
, folderPix :: Pixbuf
, folderSymPix :: Pixbuf
, filePix :: Pixbuf
, fileSymPix :: Pixbuf
, errorPix :: Pixbuf
, scroll :: ScrolledWindow
}
@ -96,17 +92,24 @@ data FMSettings = MkFMSettings {
, isLazy :: Bool
}
data FMView = FMTreeView TreeView
| FMIconView IconView
type Row = AnchoredFile FileInfo
type Item = AnchoredFile FileInfo
-- |This describes the contents of the treeView and is separated from MyGUI,
-- |This describes the contents of the current vie and is separated from MyGUI,
-- because we might want to have multiple views.
data MyView = MkMyView {
rawModel :: TVar (ListStore Row)
, sortedModel :: TVar (TypedTreeModelSort Row)
, filteredModel :: TVar (TypedTreeModelFilter Row)
view :: TVar FMView
, rawModel :: TVar (ListStore Item)
, sortedModel :: TVar (TypedTreeModelSort Item)
, filteredModel :: TVar (TypedTreeModelFilter Item)
, operationBuffer :: TVar FileOperation
, inotify :: MVar INotify
, inotify :: MVar INotify
}
fmViewToContainer :: FMView -> Container
fmViewToContainer (FMTreeView x) = castToContainer . toGObject $ x
fmViewToContainer (FMIconView x) = castToContainer . toGObject $ x

123
src/GUI/Gtk/MyGUI.hs Normal file
View File

@ -0,0 +1,123 @@
{--
HSFM, a filemanager written in Haskell.
Copyright (C) 2015 Julian Ospald
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.
--}
{-# OPTIONS_HADDOCK ignore-exports #-}
module GUI.Gtk.MyGUI where
import Control.Concurrent.STM
(
newTVarIO
)
import Graphics.UI.Gtk
import GUI.Gtk.Data
import GUI.Gtk.Icons
import Paths_hsfm
(
getDataFileName
)
-------------------------
--[ Main Window Setup ]--
-------------------------
-- |Set up the GUI. This only creates the permanent widgets.
createMyGUI :: IO MyGUI
createMyGUI = do
settings <- newTVarIO (MkFMSettings False True)
-- get the icons
iT <- iconThemeGetDefault
folderPix <- getIcon IFolder iT 24
folderSymPix <- getSymlinkIcon IFolder iT 24
filePix <- getIcon IFile iT 24
fileSymPix <- getSymlinkIcon IFile iT 24
errorPix <- getIcon IError iT 24
builder <- builderNew
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
-- get the pre-defined gui widgets
rootWin <- builderGetObject builder castToWindow
"rootWin"
scroll <- builderGetObject builder castToScrolledWindow
"mainScroll"
menubarFileQuit <- builderGetObject builder castToImageMenuItem
"menubarFileQuit"
menubarFileOpen <- builderGetObject builder castToImageMenuItem
"menubarFileOpen"
menubarFileExecute <- builderGetObject builder castToImageMenuItem
"menubarFileExecute"
menubarFileNew <- builderGetObject builder castToImageMenuItem
"menubarFileNew"
menubarEditCut <- builderGetObject builder castToImageMenuItem
"menubarEditCut"
menubarEditCopy <- builderGetObject builder castToImageMenuItem
"menubarEditCopy"
menubarEditRename <- builderGetObject builder castToImageMenuItem
"menubarEditRename"
menubarEditPaste <- builderGetObject builder castToImageMenuItem
"menubarEditPaste"
menubarEditDelete <- builderGetObject builder castToImageMenuItem
"menubarEditDelete"
menubarHelpAbout <- builderGetObject builder castToImageMenuItem
"menubarHelpAbout"
urlBar <- builderGetObject builder castToEntry
"urlBar"
statusBar <- builderGetObject builder castToStatusbar
"statusBar"
clearStatusBar <- builderGetObject builder castToButton
"clearStatusBar"
rcMenu <- builderGetObject builder castToMenu
"rcMenu"
rcFileOpen <- builderGetObject builder castToImageMenuItem
"rcFileOpen"
rcFileExecute <- builderGetObject builder castToImageMenuItem
"rcFileExecute"
rcFileNew <- builderGetObject builder castToImageMenuItem
"rcFileNew"
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"
refreshViewB <- builderGetObject builder castToButton
"refreshViewB"
menubarViewTree <- builderGetObject builder castToImageMenuItem
"menubarViewTree"
menubarViewIcon <- builderGetObject builder castToImageMenuItem
"menubarViewIcon"
-- construct the gui object
let mygui = MkMyGUI {..}
-- sets the default icon
windowSetDefaultIconFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png"
return mygui

307
src/GUI/Gtk/MyView.hs Normal file
View File

@ -0,0 +1,307 @@
{--
HSFM, a filemanager written in Haskell.
Copyright (C) 2015 Julian Ospald
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.
--}
{-# OPTIONS_HADDOCK ignore-exports #-}
module GUI.Gtk.MyView where
import Control.Applicative
(
(<$>)
)
import Control.Concurrent.MVar
(
newEmptyMVar
, putMVar
, tryTakeMVar
)
import Control.Concurrent.STM
(
newTVarIO
, readTVarIO
)
import Data.DirTree
import Data.Foldable
(
for_
)
import Data.Maybe
(
catMaybes
)
import Graphics.UI.Gtk
import {-# SOURCE #-} GUI.Gtk.Callbacks (setCallbacks)
import GUI.Gtk.Data
import GUI.Gtk.Utils
import IO.File
import IO.Utils
import System.FilePath
(
isAbsolute
)
import System.INotify
(
addWatch
, initINotify
, killINotify
, EventVariety(..)
, Event(..)
)
-- |Constructs the initial MyView object with a few dummy models.
-- It also initializes the callbacks.
createMyView :: MyGUI -> IO FMView -> IO MyView
createMyView mygui iofmv = do
operationBuffer <- newTVarIO None
inotify <- newEmptyMVar
-- 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
view' <- iofmv
view <- newTVarIO view'
let myview = MkMyView {..}
-- set the bindings
setCallbacks mygui myview
-- add the treeview to the scroll container
let oview = fmViewToContainer view'
containerAdd (scroll mygui) oview
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
view' <- readTVarIO $ view myview
let oview = fmViewToContainer view'
widgetDestroy oview
nview' <- iofmv
let nview = fmViewToContainer nview'
writeTVarIO (view myview) nview'
setCallbacks mygui myview
containerAdd (scroll mygui) nview
widgetShow nview
refreshView mygui myview Nothing
-- |Createss an IconView.
createIconView :: IO FMView
createIconView = do
iconv <- iconViewNew
iconViewSetSelectionMode iconv SelectionMultiple
iconViewSetColumns iconv (-1)
iconViewSetSpacing iconv 2
iconViewSetMargin iconv 0
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
-- 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
treeViewColumnSetTitle cF "Filename"
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
treeViewColumnSetTitle cMD "Date"
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
treeViewColumnSetTitle cP "Permission"
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.
refreshView :: MyGUI
-> MyView
-> Maybe FilePath
-> IO ()
refreshView mygui myview mfp =
case mfp of
Just fp -> do
cdir <- (\x -> if (failed . file $ x) || (not . isAbsolute . anchor $ x)
then Data.DirTree.readFile "/"
else return x) =<< Data.DirTree.readFile fp
refreshView' mygui myview cdir
Nothing -> refreshView' mygui myview =<< getCurrentDir myview
-- |Refreshes the View based on the given directory.
refreshView' :: MyGUI
-> MyView
-> AnchoredFile FileInfo
-> IO ()
refreshView' mygui myview dt@(ADirOrSym _) = do
newRawModel <- fileListStore dt myview
writeTVarIO (rawModel myview) newRawModel
view' <- readTVarIO $ view myview
-- get selected items
tps <- getSelectedTreePaths mygui myview
trs <- catMaybes <$> mapM (treeRowReferenceNew newRawModel) tps
constructView mygui myview
-- 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 ()
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
view' <- readTVarIO $ view myview
cdirp <- anchor <$> getFirstItem myview
-- update urlBar
entrySetText (urlBar mygui) cdirp
rawModel' <- readTVarIO $ rawModel myview
-- filtering
filteredModel' <- treeModelFilterNew rawModel' []
writeTVarIO (filteredModel myview) filteredModel'
treeModelFilterSetVisibleFunc filteredModel' $ \iter -> do
hidden <- showHidden <$> readTVarIO (settings mygui)
item <- (name . file) <$> treeModelGetRow rawModel' iter
if hidden
then return True
else return $ not . hiddenFile $ item
-- 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)
(dirtreePix . file)
treeModelSetColumn rawModel' (makeColumnIdString 1)
(name . file)
treeModelSetColumn rawModel' (makeColumnIdString 2)
(packModTime . file)
treeModelSetColumn rawModel' (makeColumnIdString 3)
(packPermissions . file)
-- 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
w <- addWatch
newi
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
cdirp
(\_ -> postGUIAsync $ refreshView mygui myview (Just cdirp))
putMVar (inotify myview) newi
return ()
where
dirtreePix (Dir {}) = folderPix mygui
dirtreePix (FileLike {}) = filePix mygui
dirtreePix (DirSym _) = folderSymPix mygui
dirtreePix (FileLikeSym {}) = fileSymPix mygui
dirtreePix (Failed {}) = errorPix mygui
dirtreePix (BrokenSymlink _) = errorPix mygui
dirtreePix _ = errorPix mygui

View File

@ -25,30 +25,14 @@ import Control.Applicative
(
(<$>)
)
import Control.Concurrent.MVar
(
putMVar
, tryTakeMVar
)
import Control.Concurrent.STM
(
TVar
, newTVarIO
, readTVarIO
readTVarIO
)
import Data.DirTree
import Data.Foldable
(
for_
)
import Data.List
(
isPrefixOf
)
import Data.Maybe
(
catMaybes
, fromMaybe
, fromJust
)
import Data.Traversable
@ -57,17 +41,6 @@ import Data.Traversable
)
import Graphics.UI.Gtk
import GUI.Gtk.Data
import IO.Error
import IO.Utils
import MyPrelude
import System.INotify
(
addWatch
, initINotify
, killINotify
, EventVariety(..)
, Event(..)
)
@ -77,22 +50,34 @@ import System.INotify
-----------------
-- |Gets the currently selected row of the treeView, if any.
--
-- Interaction with mutable references:
--
-- * 'rawModel' reads
-- * 'sortedModel' reads
-- * 'filteredModel' reads
getSelectedRows :: MyGUI
-> MyView
-> IO [Row]
getSelectedRows mygui myview = do
tvs <- treeViewGetSelection (treeView mygui)
tps <- treeSelectionGetSelectedRows tvs
getSelectedTreePaths :: MyGUI -> MyView -> IO [TreePath]
getSelectedTreePaths _ myview = do
view' <- readTVarIO $ view myview
case view' of
FMTreeView treeView -> do
tvs <- treeViewGetSelection treeView
treeSelectionGetSelectedRows tvs
FMIconView iconView ->
iconViewGetSelectedItems iconView
-- |Gets the currently selected item of the treeView, if any.
getSelectedItems :: MyGUI
-> MyView
-> IO [Item]
getSelectedItems mygui myview = do
tps <- getSelectedTreePaths mygui myview
getSelectedItems' mygui myview tps
getSelectedItems' :: MyGUI
-> MyView
-> [TreePath]
-> IO [Item]
getSelectedItems' mygui myview tps = do
rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview
filteredModel' <- readTVarIO $ filteredModel myview
rawModel' <- readTVarIO $ rawModel myview
iters <- catMaybes <$> mapM (treeModelGetIter sortedModel') tps
forM iters $ \iter -> do
cIter' <- treeModelSortConvertIterToChildIter sortedModel' iter
@ -100,19 +85,21 @@ getSelectedRows mygui myview = do
treeModelGetRow rawModel' cIter
-- |Carry out an action on the currently selected row.
-- |Carry out an action on the currently selected item.
--
-- If there is no row selected, does nothing.
withRows :: MyGUI
-> MyView
-> ( [Row]
-> MyGUI
-> MyView
-> IO ()) -- ^ action to carry out
-> IO ()
withRows mygui myview io = do
rows <- getSelectedRows mygui myview
io rows mygui myview
-- If there is no item selected, does nothing.
withItems :: MyGUI
-> MyView
-> ( [Item]
-> MyGUI
-> MyView
-> IO ()) -- ^ action to carry out
-> IO ()
withItems mygui myview io = do
items <- getSelectedItems mygui myview
io items mygui myview
-- |Create the 'ListStore' of files/directories from the current directory.
@ -120,172 +107,29 @@ withRows mygui myview io = do
-- into the GTK+ data structures.
fileListStore :: AnchoredFile FileInfo -- ^ current dir
-> MyView
-> IO (ListStore Row)
-> IO (ListStore Item)
fileListStore dt myview = do
cs <- Data.DirTree.getContents dt
listStoreNew cs
-- |Currently unsafe. This is used to obtain any row (possibly the '.' row)
-- |Currently unsafe. This is used to obtain any item (possibly the '.' item)
-- and extract the "current working directory" from it.
--
-- Interaction with mutable references:
--
-- * 'rawModel' reads
getFirstRow :: MyView
getFirstItem :: MyView
-> IO (AnchoredFile FileInfo)
getFirstRow myview = do
getFirstItem myview = do
rawModel' <- readTVarIO $ rawModel myview
iter <- fromJust <$> treeModelGetIterFirst rawModel'
treeModelGetRow rawModel' iter
-- |Currently unsafe. Gets the current directory via `getFirstRow` and `goUp`.
-- |Currently unsafe. Gets the current directory via `getFirstItem` and
-- `goUp`.
getCurrentDir :: MyView
-> IO (AnchoredFile FileInfo)
getCurrentDir myview = getFirstRow myview >>= goUp
getCurrentDir myview = getFirstItem myview >>= goUp
-- |Re-reads the current directory or the given one and updates the TreeView.
--
-- The operation may fail with:
--
-- * 'DirDoesNotExist' if the target directory does not exist
-- * 'PathNotAbsolute' if the target directory is not absolute
--
-- Interaction with mutable references:
--
-- * 'rawModel' writes
refreshTreeView :: MyGUI
-> MyView
-> Maybe FilePath
-> IO ()
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.
--
-- Interaction with mutable references:
--
-- * 'rawModel' writes
refreshTreeView' :: MyGUI
-> MyView
-> AnchoredFile FileInfo
-> IO ()
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
-- |Constructs the visible TreeView with the current underlying mutable models,
-- which are retrieved from 'MyGUI'.
--
-- Interaction with mutable references:
--
-- * 'rawModel' reads
-- * 'filteredModel' writes
-- * 'sortedModel' writes
-- * 'settings' reads
constructTreeView :: MyGUI
-> MyView
-> IO ()
constructTreeView mygui myview = do
let treeView' = treeView mygui
cF' = cF mygui
cMD' = cMD mygui
render' = renderTxt mygui
cdirp <- anchor <$> getFirstRow myview
-- update urlBar
entrySetText (urlBar mygui) cdirp
rawModel' <- readTVarIO $ rawModel myview
-- filtering
filteredModel' <- treeModelFilterNew rawModel' []
writeTVarIO (filteredModel myview) filteredModel'
treeModelFilterSetVisibleFunc filteredModel' $ \iter -> do
hidden <- showHidden <$> readTVarIO (settings mygui)
row <- (name . file) <$> treeModelGetRow rawModel' iter
if hidden
then return True
else return $ not . hiddenFile $ row
-- sorting
sortedModel' <- treeModelSortNewWithModel filteredModel'
writeTVarIO (sortedModel myview) sortedModel'
treeSortableSetSortFunc sortedModel' 1 $ \iter1 iter2 -> do
cIter1 <- treeModelFilterConvertIterToChildIter filteredModel' iter1
cIter2 <- treeModelFilterConvertIterToChildIter filteredModel' iter2
row1 <- treeModelGetRow rawModel' cIter1
row2 <- treeModelGetRow rawModel' cIter2
return $ compare row1 row2
treeSortableSetSortColumnId sortedModel' 1 SortAscending
-- set values
treeModelSetColumn rawModel' (makeColumnIdPixbuf 0)
(dirtreePix . file)
treeModelSetColumn rawModel' (makeColumnIdString 1)
(name . file)
treeModelSetColumn rawModel' (makeColumnIdString 2)
(packModTime . file)
treeModelSetColumn rawModel' (makeColumnIdString 3)
(packPermissions . file)
-- update treeview model
treeViewSetModel treeView' sortedModel'
treeViewSetRubberBanding treeView' True
-- 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 (FileLike {}) = filePix mygui
dirtreePix (DirSym _) = folderSymPix mygui
dirtreePix (FileLikeSym {}) = fileSymPix mygui
dirtreePix (Failed {}) = errorPix mygui
dirtreePix (BrokenSymlink _) = errorPix mygui
dirtreePix _ = errorPix mygui
-- |Push a message to the status bar.