GTK: use new History module
This commit is contained in:
parent
d904b74629
commit
05a62cb382
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user