hsfm/src/HSFM/GUI/Gtk/Utils.hs

155 lines
4.2 KiB
Haskell
Raw Normal View History

2015-12-24 17:25:05 +00:00
{--
HSFM, a filemanager written in Haskell.
2016-03-30 22:28:23 +00:00
Copyright (C) 2016 Julian Ospald
2015-12-24 17:25:05 +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.
--}
{-# OPTIONS_HADDOCK ignore-exports #-}
2016-03-30 18:16:34 +00:00
module HSFM.GUI.Gtk.Utils where
import Control.Concurrent.MVar
(
readMVar
)
import Control.Concurrent.STM
(
readTVarIO
)
import Data.Maybe
(
catMaybes
, fromJust
)
import Data.Traversable
(
forM
)
import Graphics.UI.Gtk
2016-03-30 18:16:34 +00:00
import HSFM.FileSystem.FileType
import HSFM.GUI.Gtk.Data
import Prelude hiding(getContents)
-----------------
--[ Utilities ]--
-----------------
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
catMaybes <$> mapM (rawPathToItem myview) tps
-- |Carry out an action on the currently selected item.
--
-- 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.
-- This is the function which maps the Data.DirTree data structures
-- into the GTK+ data structures.
fileListStore :: Item -- ^ current dir
-> MyView
-> IO (ListStore Item)
2016-03-31 14:19:31 +00:00
fileListStore dt _ = do
cs <- getContents getFileInfo dt
listStoreNew cs
-- |Currently unsafe. This is used to obtain any item, which will
-- fail if there is none.
getFirstItem :: MyView
-> IO Item
getFirstItem myview = do
rawModel' <- readTVarIO $ rawModel myview
iter <- fromJust <$> treeModelGetIterFirst rawModel'
treeModelGetRow rawModel' iter
-- |Reads the current directory from MyView.
--
-- This reads the MVar and may block the main thread if it's
-- empty.
getCurrentDir :: MyView
-> IO Item
getCurrentDir myview = readMVar (cwd myview)
-- |Push a message to the status bar.
pushStatusBar :: MyGUI -> String -> IO (ContextId, MessageId)
pushStatusBar mygui str = do
let sb = statusBar mygui
cid <- statusbarGetContextId sb "FM Status"
mid <- statusbarPush sb cid str
return (cid, mid)
-- |Pop a message from the status bar.
popStatusbar :: MyGUI -> IO ()
popStatusbar mygui = do
let sb = statusBar mygui
cid <- statusbarGetContextId sb "FM Status"
statusbarPop sb cid
-- |Turn a path on the rawModel into a path that we can
-- use at the outermost model layer.
rawPathToIter :: MyView -> TreePath -> IO (Maybe TreeIter)
rawPathToIter myview tp = do
fmodel <- readTVarIO (filteredModel myview)
smodel <- readTVarIO (sortedModel myview)
msiter <- treeModelGetIter smodel tp
forM msiter $ \siter -> do
cIter <- treeModelSortConvertIterToChildIter smodel siter
treeModelFilterConvertIterToChildIter fmodel cIter
-- |Turn a path on the rawModel into the corresponding item
-- that we can use at the outermost model layer.
rawPathToItem :: MyView -> TreePath -> IO (Maybe Item)
rawPathToItem myview tp = do
rawModel' <- readTVarIO $ rawModel myview
miter <- rawPathToIter myview tp
forM miter $ \iter -> treeModelGetRow rawModel' iter