GTK: use new History module

This commit is contained in:
Julian Ospald 2016-06-04 17:28:15 +02:00
parent d904b74629
commit 05a62cb382
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
5 changed files with 53 additions and 54 deletions

View File

@ -72,6 +72,7 @@ import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Dialogs
import HSFM.GUI.Gtk.MyView
import HSFM.GUI.Gtk.Utils
import HSFM.History
import HSFM.Utils.IO
import Prelude hiding(readFile)
import System.Glib.UTFString
@ -87,6 +88,11 @@ import System.Posix.Types
(
ProcessID
)
import Control.Concurrent.MVar
(
putMVar
, tryTakeMVar
)
@ -202,11 +208,11 @@ setViewCallbacks mygui myview = do
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Left" <- fmap glibToString eventKeyName
liftIO $ goHistoryPrev mygui myview
liftIO $ goHistoryBack mygui myview
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Right" <- fmap glibToString eventKeyName
liftIO $ goHistoryNext mygui myview
liftIO $ goHistoryForward mygui myview
_ <- view `on` keyPressEvent $ tryEvent $ do
"Delete" <- fmap glibToString eventKeyName
liftIO $ withItems mygui myview del
@ -277,10 +283,10 @@ setViewCallbacks mygui myview = do
Nothing -> return False
OtherButton 8 -> do
liftIO $ goHistoryPrev mygui myview
liftIO $ goHistoryBack mygui myview
return False
OtherButton 9 -> do
liftIO $ goHistoryNext mygui myview
liftIO $ goHistoryForward mygui myview
return False
-- not right-click, so pass on the signal
_ -> return False
@ -535,29 +541,23 @@ upDir mygui myview = withErrorDialog $ do
-- |Go "back" in the history.
goHistoryPrev :: MyGUI -> MyView -> IO ()
goHistoryPrev mygui myview = do
hs <- readTVarIO (history myview)
case hs of
([], _) -> return ()
(x:xs, _) -> do
cdir <- getCurrentDir myview
nv <- readFile getFileInfo $ x
modifyTVarIO (history myview)
(\(_, n) -> (xs, path cdir `addHistory` n))
goDir False mygui myview nv
goHistoryBack :: MyGUI -> MyView -> IO ()
goHistoryBack mygui myview = do
mhs <- tryTakeMVar (history myview)
for_ mhs $ \hs -> do
let nhs = goBack hs
putMVar (history myview) nhs
nv <- readFile getFileInfo $ currentDir nhs
goDir False mygui myview nv
-- |Go "forth" in the history.
goHistoryNext :: MyGUI -> MyView -> IO ()
goHistoryNext mygui myview = do
hs <- readTVarIO (history myview)
case hs of
(_, []) -> return ()
(_, x:xs) -> do
cdir <- getCurrentDir myview
nv <- readFile getFileInfo $ x
modifyTVarIO (history myview)
(\(p, _) -> (path cdir `addHistory` p, xs))
goDir False mygui myview nv
-- |Go "forward" in the history.
goHistoryForward :: MyGUI -> MyView -> IO ()
goHistoryForward mygui myview = do
mhs <- tryTakeMVar (history myview)
for_ mhs $ \hs -> do
let nhs = goForward hs
putMVar (history myview) nhs
nv <- readFile getFileInfo $ currentDir nhs
goDir False mygui myview nv

View File

@ -29,6 +29,10 @@ import Control.Monad
forM_
, when
)
import Data.Foldable
(
for_
)
import Data.Maybe
(
fromJust
@ -46,12 +50,13 @@ import HSFM.FileSystem.UtilTypes
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Dialogs
import HSFM.GUI.Gtk.MyView
import HSFM.GUI.Gtk.Utils
import HSFM.Utils.IO
(
modifyTVarIO
)
import HSFM.History
import Prelude hiding(readFile)
import Control.Concurrent.MVar
(
putMVar
, tryTakeMVar
)
@ -103,9 +108,11 @@ goDir :: Bool -- ^ whether to update the history
-> Item
-> IO ()
goDir bhis mygui myview item = do
cdir <- getCurrentDir myview
when bhis $ modifyTVarIO (history myview)
(\(p, _) -> (path cdir `addHistory` p, []))
when bhis $ do
mhs <- tryTakeMVar (history myview)
for_ mhs $ \hs -> do
let nhs = goNewPath (path item) hs
putMVar (history myview) nhs
refreshView mygui myview item
-- set notebook tab label

View File

@ -30,13 +30,9 @@ import Control.Concurrent.STM
TVar
)
import Graphics.UI.Gtk hiding (MenuBar)
import HPath
(
Abs
, Path
)
import HSFM.FileSystem.FileType
import HSFM.FileSystem.UtilTypes
import HSFM.History
import System.INotify
(
INotify
@ -83,7 +79,7 @@ data MyView = MkMyView {
-- the first part of the tuple represents the "go back"
-- the second part the "go forth" in the history
, history :: !(TVar ([Path Abs], [Path Abs]))
, history :: !(MVar BrowsingHistory)
-- sub-widgets
, scroll :: !ScrolledWindow

View File

@ -64,6 +64,7 @@ import HSFM.GUI.Glib.GlibString()
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Icons
import HSFM.GUI.Gtk.Utils
import HSFM.History
import HSFM.Utils.IO
import Paths_hsfm
(
@ -93,6 +94,8 @@ import System.Posix.FilePath
-- |Creates a new tab with its own view and refreshes the view.
newTab :: MyGUI -> IO FMView -> Item -> Int -> IO MyView
newTab mygui iofmv item pos = do
-- create eventbox with label
label <- labelNewWithMnemonic
(maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
@ -105,6 +108,11 @@ newTab mygui iofmv item pos = do
_ <- notebookInsertPageMenu (notebook mygui) (viewBox myview)
ebox ebox pos
-- set initial history
let historySize = 5
putMVar (history myview)
(BrowsingHistory [] (path item) [] historySize)
notebookSetTabReorderable (notebook mygui) (viewBox myview) True
catchIOError (refreshView mygui myview item) $ \e -> do
@ -134,7 +142,7 @@ createMyView :: MyGUI
-> IO MyView
createMyView mygui iofmv = do
inotify <- newEmptyMVar
history <- newTVarIO ([],[])
history <- newEmptyMVar
builder <- builderNew
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"

View File

@ -152,15 +152,3 @@ rawPathToItem myview tp = do
miter <- rawPathToIter myview tp
forM miter $ \iter -> treeModelGetRow rawModel' iter
-- |Makes sure the list is max 5. This is probably not very efficient
-- but we don't care, since it's a small list anyway.
addHistory :: Eq a => a -> [a] -> [a]
addHistory i [] = [i]
addHistory i xs@(x:_)
| i == x = xs
| length xs == maxLength = i : take (maxLength - 1) xs
| otherwise = i : xs
where
maxLength = 10