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.Dialogs
|
||||||
import HSFM.GUI.Gtk.MyView
|
import HSFM.GUI.Gtk.MyView
|
||||||
import HSFM.GUI.Gtk.Utils
|
import HSFM.GUI.Gtk.Utils
|
||||||
|
import HSFM.History
|
||||||
import HSFM.Utils.IO
|
import HSFM.Utils.IO
|
||||||
import Prelude hiding(readFile)
|
import Prelude hiding(readFile)
|
||||||
import System.Glib.UTFString
|
import System.Glib.UTFString
|
||||||
@ -87,6 +88,11 @@ import System.Posix.Types
|
|||||||
(
|
(
|
||||||
ProcessID
|
ProcessID
|
||||||
)
|
)
|
||||||
|
import Control.Concurrent.MVar
|
||||||
|
(
|
||||||
|
putMVar
|
||||||
|
, tryTakeMVar
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -202,11 +208,11 @@ setViewCallbacks mygui myview = do
|
|||||||
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
|
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
|
||||||
[Alt] <- eventModifier
|
[Alt] <- eventModifier
|
||||||
"Left" <- fmap glibToString eventKeyName
|
"Left" <- fmap glibToString eventKeyName
|
||||||
liftIO $ goHistoryPrev mygui myview
|
liftIO $ goHistoryBack mygui myview
|
||||||
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
|
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
|
||||||
[Alt] <- eventModifier
|
[Alt] <- eventModifier
|
||||||
"Right" <- fmap glibToString eventKeyName
|
"Right" <- fmap glibToString eventKeyName
|
||||||
liftIO $ goHistoryNext mygui myview
|
liftIO $ goHistoryForward mygui myview
|
||||||
_ <- view `on` keyPressEvent $ tryEvent $ do
|
_ <- view `on` keyPressEvent $ tryEvent $ do
|
||||||
"Delete" <- fmap glibToString eventKeyName
|
"Delete" <- fmap glibToString eventKeyName
|
||||||
liftIO $ withItems mygui myview del
|
liftIO $ withItems mygui myview del
|
||||||
@ -277,10 +283,10 @@ setViewCallbacks mygui myview = do
|
|||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
|
|
||||||
OtherButton 8 -> do
|
OtherButton 8 -> do
|
||||||
liftIO $ goHistoryPrev mygui myview
|
liftIO $ goHistoryBack mygui myview
|
||||||
return False
|
return False
|
||||||
OtherButton 9 -> do
|
OtherButton 9 -> do
|
||||||
liftIO $ goHistoryNext mygui myview
|
liftIO $ goHistoryForward mygui myview
|
||||||
return False
|
return False
|
||||||
-- not right-click, so pass on the signal
|
-- not right-click, so pass on the signal
|
||||||
_ -> return False
|
_ -> return False
|
||||||
@ -535,29 +541,23 @@ upDir mygui myview = withErrorDialog $ do
|
|||||||
|
|
||||||
|
|
||||||
-- |Go "back" in the history.
|
-- |Go "back" in the history.
|
||||||
goHistoryPrev :: MyGUI -> MyView -> IO ()
|
goHistoryBack :: MyGUI -> MyView -> IO ()
|
||||||
goHistoryPrev mygui myview = do
|
goHistoryBack mygui myview = do
|
||||||
hs <- readTVarIO (history myview)
|
mhs <- tryTakeMVar (history myview)
|
||||||
case hs of
|
for_ mhs $ \hs -> do
|
||||||
([], _) -> return ()
|
let nhs = goBack hs
|
||||||
(x:xs, _) -> do
|
putMVar (history myview) nhs
|
||||||
cdir <- getCurrentDir myview
|
nv <- readFile getFileInfo $ currentDir nhs
|
||||||
nv <- readFile getFileInfo $ x
|
goDir False mygui myview nv
|
||||||
modifyTVarIO (history myview)
|
|
||||||
(\(_, n) -> (xs, path cdir `addHistory` n))
|
|
||||||
goDir False mygui myview nv
|
|
||||||
|
|
||||||
|
|
||||||
-- |Go "forth" in the history.
|
-- |Go "forward" in the history.
|
||||||
goHistoryNext :: MyGUI -> MyView -> IO ()
|
goHistoryForward :: MyGUI -> MyView -> IO ()
|
||||||
goHistoryNext mygui myview = do
|
goHistoryForward mygui myview = do
|
||||||
hs <- readTVarIO (history myview)
|
mhs <- tryTakeMVar (history myview)
|
||||||
case hs of
|
for_ mhs $ \hs -> do
|
||||||
(_, []) -> return ()
|
let nhs = goForward hs
|
||||||
(_, x:xs) -> do
|
putMVar (history myview) nhs
|
||||||
cdir <- getCurrentDir myview
|
nv <- readFile getFileInfo $ currentDir nhs
|
||||||
nv <- readFile getFileInfo $ x
|
goDir False mygui myview nv
|
||||||
modifyTVarIO (history myview)
|
|
||||||
(\(p, _) -> (path cdir `addHistory` p, xs))
|
|
||||||
goDir False mygui myview nv
|
|
||||||
|
|
||||||
|
@ -29,6 +29,10 @@ import Control.Monad
|
|||||||
forM_
|
forM_
|
||||||
, when
|
, when
|
||||||
)
|
)
|
||||||
|
import Data.Foldable
|
||||||
|
(
|
||||||
|
for_
|
||||||
|
)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
(
|
(
|
||||||
fromJust
|
fromJust
|
||||||
@ -46,12 +50,13 @@ import HSFM.FileSystem.UtilTypes
|
|||||||
import HSFM.GUI.Gtk.Data
|
import HSFM.GUI.Gtk.Data
|
||||||
import HSFM.GUI.Gtk.Dialogs
|
import HSFM.GUI.Gtk.Dialogs
|
||||||
import HSFM.GUI.Gtk.MyView
|
import HSFM.GUI.Gtk.MyView
|
||||||
import HSFM.GUI.Gtk.Utils
|
import HSFM.History
|
||||||
import HSFM.Utils.IO
|
|
||||||
(
|
|
||||||
modifyTVarIO
|
|
||||||
)
|
|
||||||
import Prelude hiding(readFile)
|
import Prelude hiding(readFile)
|
||||||
|
import Control.Concurrent.MVar
|
||||||
|
(
|
||||||
|
putMVar
|
||||||
|
, tryTakeMVar
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -103,9 +108,11 @@ goDir :: Bool -- ^ whether to update the history
|
|||||||
-> Item
|
-> Item
|
||||||
-> IO ()
|
-> IO ()
|
||||||
goDir bhis mygui myview item = do
|
goDir bhis mygui myview item = do
|
||||||
cdir <- getCurrentDir myview
|
when bhis $ do
|
||||||
when bhis $ modifyTVarIO (history myview)
|
mhs <- tryTakeMVar (history myview)
|
||||||
(\(p, _) -> (path cdir `addHistory` p, []))
|
for_ mhs $ \hs -> do
|
||||||
|
let nhs = goNewPath (path item) hs
|
||||||
|
putMVar (history myview) nhs
|
||||||
refreshView mygui myview item
|
refreshView mygui myview item
|
||||||
|
|
||||||
-- set notebook tab label
|
-- set notebook tab label
|
||||||
|
@ -30,13 +30,9 @@ import Control.Concurrent.STM
|
|||||||
TVar
|
TVar
|
||||||
)
|
)
|
||||||
import Graphics.UI.Gtk hiding (MenuBar)
|
import Graphics.UI.Gtk hiding (MenuBar)
|
||||||
import HPath
|
|
||||||
(
|
|
||||||
Abs
|
|
||||||
, Path
|
|
||||||
)
|
|
||||||
import HSFM.FileSystem.FileType
|
import HSFM.FileSystem.FileType
|
||||||
import HSFM.FileSystem.UtilTypes
|
import HSFM.FileSystem.UtilTypes
|
||||||
|
import HSFM.History
|
||||||
import System.INotify
|
import System.INotify
|
||||||
(
|
(
|
||||||
INotify
|
INotify
|
||||||
@ -83,7 +79,7 @@ data MyView = MkMyView {
|
|||||||
|
|
||||||
-- the first part of the tuple represents the "go back"
|
-- the first part of the tuple represents the "go back"
|
||||||
-- the second part the "go forth" in the history
|
-- the second part the "go forth" in the history
|
||||||
, history :: !(TVar ([Path Abs], [Path Abs]))
|
, history :: !(MVar BrowsingHistory)
|
||||||
|
|
||||||
-- sub-widgets
|
-- sub-widgets
|
||||||
, scroll :: !ScrolledWindow
|
, scroll :: !ScrolledWindow
|
||||||
|
@ -64,6 +64,7 @@ import HSFM.GUI.Glib.GlibString()
|
|||||||
import HSFM.GUI.Gtk.Data
|
import HSFM.GUI.Gtk.Data
|
||||||
import HSFM.GUI.Gtk.Icons
|
import HSFM.GUI.Gtk.Icons
|
||||||
import HSFM.GUI.Gtk.Utils
|
import HSFM.GUI.Gtk.Utils
|
||||||
|
import HSFM.History
|
||||||
import HSFM.Utils.IO
|
import HSFM.Utils.IO
|
||||||
import Paths_hsfm
|
import Paths_hsfm
|
||||||
(
|
(
|
||||||
@ -93,6 +94,8 @@ import System.Posix.FilePath
|
|||||||
-- |Creates a new tab with its own view and refreshes the view.
|
-- |Creates a new tab with its own view and refreshes the view.
|
||||||
newTab :: MyGUI -> IO FMView -> Item -> Int -> IO MyView
|
newTab :: MyGUI -> IO FMView -> Item -> Int -> IO MyView
|
||||||
newTab mygui iofmv item pos = do
|
newTab mygui iofmv item pos = do
|
||||||
|
|
||||||
|
|
||||||
-- create eventbox with label
|
-- create eventbox with label
|
||||||
label <- labelNewWithMnemonic
|
label <- labelNewWithMnemonic
|
||||||
(maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
|
(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)
|
_ <- notebookInsertPageMenu (notebook mygui) (viewBox myview)
|
||||||
ebox ebox pos
|
ebox ebox pos
|
||||||
|
|
||||||
|
-- set initial history
|
||||||
|
let historySize = 5
|
||||||
|
putMVar (history myview)
|
||||||
|
(BrowsingHistory [] (path item) [] historySize)
|
||||||
|
|
||||||
notebookSetTabReorderable (notebook mygui) (viewBox myview) True
|
notebookSetTabReorderable (notebook mygui) (viewBox myview) True
|
||||||
|
|
||||||
catchIOError (refreshView mygui myview item) $ \e -> do
|
catchIOError (refreshView mygui myview item) $ \e -> do
|
||||||
@ -134,7 +142,7 @@ createMyView :: MyGUI
|
|||||||
-> IO MyView
|
-> IO MyView
|
||||||
createMyView mygui iofmv = do
|
createMyView mygui iofmv = do
|
||||||
inotify <- newEmptyMVar
|
inotify <- newEmptyMVar
|
||||||
history <- newTVarIO ([],[])
|
history <- newEmptyMVar
|
||||||
|
|
||||||
builder <- builderNew
|
builder <- builderNew
|
||||||
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
|
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
|
||||||
|
@ -152,15 +152,3 @@ rawPathToItem myview tp = do
|
|||||||
miter <- rawPathToIter myview tp
|
miter <- rawPathToIter myview tp
|
||||||
forM miter $ \iter -> treeModelGetRow rawModel' iter
|
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