diff --git a/data/Gtk/builder.xml b/data/Gtk/builder.xml
index 5cebac5..97bda3c 100644
--- a/data/Gtk/builder.xml
+++ b/data/Gtk/builder.xml
@@ -270,23 +270,13 @@
-
-
@@ -475,82 +361,27 @@
-
-
- False
- True
- 1
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/HSFM/GUI/Gtk.hs b/src/HSFM/GUI/Gtk.hs
index d818a3f..6f429a7 100644
--- a/src/HSFM/GUI/Gtk.hs
+++ b/src/HSFM/GUI/Gtk.hs
@@ -29,6 +29,7 @@ import Data.Maybe
)
import Graphics.UI.Gtk
import qualified HPath as P
+import HSFM.GUI.Gtk.Callbacks
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.MyGUI
import HSFM.GUI.Gtk.MyView
@@ -44,14 +45,13 @@ main = do
_ <- initGUI
args <- SPE.getArgs
-
- mygui <- createMyGUI
-
- myview <- createMyView mygui createTreeView
-
let mdir = fromMaybe (fromJust $ P.parseAbs "/")
(P.parseAbs . headDef "/" $ args)
- refreshView mygui myview (Just $ mdir)
+
+ mygui <- createMyGUI
+ _ <- newTab mygui createTreeView mdir
+
+ setGUICallbacks mygui
widgetShowAll (rootWin mygui)
diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs
index 7b62fc9..bd8c04b 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs
@@ -32,8 +32,9 @@ import Control.Exception
)
import Control.Monad
(
- void
- , forM_
+ forM_
+ , void
+ , when
)
import Control.Monad.IO.Class
(
@@ -81,9 +82,35 @@ import System.Posix.Env.ByteString
---- MAIN CALLBACK ENTRYPOINT ----
--- |Set callbacks, on hotkeys, events and stuff.
-setCallbacks :: MyGUI -> MyView -> IO ()
-setCallbacks mygui myview = do
+-- |Set callbacks for the whole gui, on hotkeys, events and stuff.
+setGUICallbacks :: MyGUI -> IO ()
+setGUICallbacks mygui = do
+
+ _ <- clearStatusBar mygui `on` buttonActivated $ do
+ popStatusbar mygui
+ writeTVarIO (operationBuffer mygui) None
+
+ -- menubar-file
+ _ <- (menubarFileQuit . menubar) mygui `on` menuItemActivated $
+ mainQuit
+
+ -- menubar-help
+ _ <- (menubarHelpAbout . menubar) mygui `on` menuItemActivated $
+ liftIO showAboutDialog
+ return ()
+
+ -- key events
+ _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
+ [Control] <- eventModifier
+ "q" <- fmap glibToString eventKeyName
+ liftIO mainQuit
+
+ return ()
+
+
+-- |Set callbacks specific to a given view, on hotkeys, events and stuff.
+setViewCallbacks :: MyGUI -> MyView -> IO ()
+setViewCallbacks mygui myview = do
view' <- readTVarIO $ view myview
case view' of
fmv@(FMTreeView treeView) -> do
@@ -126,79 +153,37 @@ setCallbacks mygui myview = do
$ (\_ -> withItems mygui myview open)
commonGuiEvents fmv
return ()
- menubarCallbacks
where
- menubarCallbacks = do
- -- menubar-file
- _ <- (menubarFileQuit . menubar) mygui `on` menuItemActivated $
- mainQuit
- _ <- (menubarFileOpen . menubar) mygui `on` menuItemActivated $
- liftIO $ withItems mygui myview open
- _ <- (menubarFileExecute . menubar) mygui `on` menuItemActivated $
- liftIO $ withItems mygui myview execute
- _ <- (menubarFileNew . menubar) mygui `on` menuItemActivated $
- liftIO $ newFile mygui myview
-
- -- menubar-edit
- _ <- (menubarEditCut . menubar) mygui `on` menuItemActivated $
- liftIO $ withItems mygui myview moveInit
- _ <- (menubarEditCopy . menubar) mygui `on` menuItemActivated $
- liftIO $ withItems mygui myview copyInit
- _ <- (menubarEditRename . menubar) mygui `on` menuItemActivated $
- liftIO $ withItems mygui myview renameF
- _ <- (menubarEditPaste . menubar) mygui `on` menuItemActivated $
- liftIO $ operationFinal mygui myview Nothing
- _ <- (menubarEditDelete . menubar) mygui `on` menuItemActivated $
- liftIO $ withItems mygui myview del
-
- -- mewnubar-view
- _ <- (menubarViewIcon . menubar) mygui `on` menuItemActivated $
- liftIO $ switchView mygui myview createIconView
- _ <- (menubarViewTree . menubar) mygui `on` menuItemActivated $
- liftIO $ switchView mygui myview createTreeView
-
- -- menubar-help
- _ <- (menubarHelpAbout . menubar) mygui `on` menuItemActivated $
- liftIO showAboutDialog
- return ()
commonGuiEvents fmv = do
let view = fmViewToContainer fmv
-- GUI events
- _ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
-
- _ <- upViewB mygui `on` buttonActivated $
+ _ <- urlBar myview `on` entryActivated $ urlGoTo mygui myview
+ _ <- upViewB myview `on` buttonActivated $
upDir mygui myview
- _ <- homeViewB mygui `on` buttonActivated $
+ _ <- homeViewB myview `on` buttonActivated $
goHome mygui myview
- _ <- refreshViewB mygui `on` buttonActivated $ do
+ _ <- refreshViewB myview `on` buttonActivated $ do
cdir <- liftIO $ getCurrentDir myview
refreshView' mygui myview cdir
- _ <- clearStatusBar mygui `on` buttonActivated $ do
- popStatusbar mygui
- writeTVarIO (operationBuffer myview) None
-- key events
- _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
- [Control] <- eventModifier
- "q" <- fmap glibToString eventKeyName
- liftIO mainQuit
- _ <- view `on` keyPressEvent $ tryEvent $ do
+ _ <- viewBox myview `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
- _ <- view `on` keyPressEvent $ tryEvent $ do
+ _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Up" <- fmap glibToString eventKeyName
liftIO $ upDir mygui myview
- _ <- view `on` keyPressEvent $ tryEvent $ do
+ _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Left" <- fmap glibToString eventKeyName
liftIO $ goHistoryPrev mygui myview
- _ <- view `on` keyPressEvent $ tryEvent $ do
+ _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Right" <- fmap glibToString eventKeyName
liftIO $ goHistoryNext mygui myview
@@ -217,10 +202,20 @@ setCallbacks mygui myview = do
[Control] <- eventModifier
"x" <- fmap glibToString eventKeyName
liftIO $ withItems mygui myview moveInit
- _ <- view `on` keyPressEvent $ tryEvent $ do
+ _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"v" <- fmap glibToString eventKeyName
liftIO $ operationFinal mygui myview Nothing
+ _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
+ [Control] <- eventModifier
+ "t" <- fmap glibToString eventKeyName
+ liftIO $ void $ do
+ cwd <- getCurrentDir myview
+ newTab mygui createTreeView (path cwd)
+ _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
+ [Control] <- eventModifier
+ "w" <- fmap glibToString eventKeyName
+ liftIO $ void $ closeTab mygui myview
-- righ-click
_ <- view `on` buttonPressEvent $ do
@@ -228,7 +223,7 @@ setCallbacks mygui myview = do
t <- eventTime
case eb of
RightButton -> do
- _ <- liftIO $ menuPopup (rcMenu . rcmenu $ mygui)
+ _ <- liftIO $ menuPopup (rcMenu . rcmenu $ myview)
$ Just (RightButton, t)
-- this is just to not screw with current selection
-- on right-click
@@ -252,27 +247,34 @@ setCallbacks mygui myview = do
return False
-- not right-click, so pass on the signal
_ -> return False
- _ <- (rcFileOpen . rcmenu) mygui `on` menuItemActivated $
+
+ -- right click menu
+ _ <- (rcFileOpen . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview open
- _ <- (rcFileExecute . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileExecute . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview execute
- _ <- (rcFileNewRegFile . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileNewRegFile . rcmenu) myview `on` menuItemActivated $
liftIO $ newFile mygui myview
- _ <- (rcFileNewDir . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileNewDir . rcmenu) myview `on` menuItemActivated $
liftIO $ newDir mygui myview
- _ <- (rcFileCopy . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileCopy . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview copyInit
- _ <- (rcFileRename . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileRename . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview renameF
- _ <- (rcFilePaste . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFilePaste . rcmenu) myview `on` menuItemActivated $
liftIO $ operationFinal mygui myview Nothing
- _ <- (rcFileDelete . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileDelete . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview del
- _ <- (rcFileProperty . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileProperty . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview showFilePropertyDialog
- _ <- (rcFileCut . rcmenu) mygui `on` menuItemActivated $
+ _ <- (rcFileCut . rcmenu) myview `on` menuItemActivated $
liftIO $ withItems mygui myview moveInit
+ _ <- (rcFileIconView . rcmenu) myview `on` menuItemActivated $
+ liftIO $ switchView mygui myview createIconView
+ _ <- (rcFileTreeView . rcmenu) myview `on` menuItemActivated $
+ liftIO $ switchView mygui myview createTreeView
return ()
+
getPathAtPos fmv (x, y) =
case fmv of
FMTreeView treeView -> do
@@ -285,6 +287,16 @@ setCallbacks mygui myview = do
+---- TAB OPERATIONMS ----
+
+
+-- |Closes the current tab, but only if there is more than one tab.
+closeTab :: MyGUI -> MyView -> IO ()
+closeTab mygui myview = do
+ n <- notebookGetNPages (notebook mygui)
+ when (n > 1) $ void $ destroyView mygui myview
+
+
---- FILE OPERATION CALLBACKS (COPY, MOVE, ...) ----
@@ -307,8 +319,8 @@ del _ _ _ = withErrorDialog
-- |Initializes a file move operation.
moveInit :: [Item] -> MyGUI -> MyView -> IO ()
-moveInit items@(_:_) mygui myview = do
- writeTVarIO (operationBuffer myview) (FMove . MP1 . map path $ items)
+moveInit items@(_:_) mygui _ = do
+ writeTVarIO (operationBuffer mygui) (FMove . MP1 . map path $ items)
let sbmsg = case items of
(item:[]) -> "Move buffer: " ++ getFPasStr item
_ -> "Move buffer: " ++ (show . length $ items)
@@ -321,8 +333,8 @@ moveInit _ _ _ = withErrorDialog
-- |Supposed to be used with 'withRows'. Initializes a file copy operation.
copyInit :: [Item] -> MyGUI -> MyView -> IO ()
-copyInit items@(_:_) mygui myview = do
- writeTVarIO (operationBuffer myview) (FCopy . CP1 . map path $ items)
+copyInit items@(_:_) mygui _ = do
+ writeTVarIO (operationBuffer mygui) (FCopy . CP1 . map path $ items)
let sbmsg = case items of
(item:[]) -> "Copy buffer: " ++ getFPasStr item
_ -> "Copy buffer: " ++ (show . length $ items)
@@ -337,7 +349,7 @@ copyInit _ _ _ = withErrorDialog
-- |Finalizes a file operation, such as copy or move.
operationFinal :: MyGUI -> MyView -> Maybe Item -> IO ()
operationFinal mygui myview mitem = withErrorDialog $ do
- op <- readTVarIO (operationBuffer myview)
+ op <- readTVarIO (operationBuffer mygui)
cdir <- case mitem of
Nothing -> path <$> getCurrentDir myview
Just x -> return $ path x
@@ -350,7 +362,7 @@ operationFinal mygui myview mitem = withErrorDialog $ do
$ \cm -> do
void $ runFileOp (FMove . MC s cdir $ cm)
popStatusbar mygui
- writeTVarIO (operationBuffer myview) None
+ writeTVarIO (operationBuffer mygui) None
FCopy (CP1 s) -> do
let cmsg = "Really copy " ++ imsg s
++ " to \"" ++ P.fpToString (P.fromAbs cdir)
@@ -411,7 +423,7 @@ renameF _ _ _ = withErrorDialog
-- If the url is invalid, does nothing.
urlGoTo :: MyGUI -> MyView -> IO ()
urlGoTo mygui myview = withErrorDialog $ do
- fp <- entryGetText (urlBar mygui)
+ fp <- entryGetText (urlBar myview)
forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
whenM (canOpenDirectory fp')
(goDir mygui myview =<< (readFile getFileInfo $ fp'))
diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs-boot b/src/HSFM/GUI/Gtk/Callbacks.hs-boot
index 73bb6d2..4d192f6 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs-boot
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs-boot
@@ -22,4 +22,4 @@ module HSFM.GUI.Gtk.Callbacks where
import HSFM.GUI.Gtk.Data
-setCallbacks :: MyGUI -> MyView -> IO ()
+setViewCallbacks :: MyGUI -> MyView -> IO ()
diff --git a/src/HSFM/GUI/Gtk/Data.hs b/src/HSFM/GUI/Gtk/Data.hs
index 8d8bc6f..a7fe07f 100644
--- a/src/HSFM/GUI/Gtk/Data.hs
+++ b/src/HSFM/GUI/Gtk/Data.hs
@@ -58,37 +58,47 @@ data MyGUI = MkMyGUI {
rootWin :: !Window
-- widgets on the main window
- , upViewB :: !Button
- , homeViewB :: !Button
- , refreshViewB :: !Button
- , urlBar :: !Entry
+ , menubar :: !MenuBar
, statusBar :: !Statusbar
, clearStatusBar :: !Button
- , scroll :: !ScrolledWindow
-
- , fprop :: !FilePropertyGrid
-
- -- sub-widgets
- , menubar :: !MenuBar
- , rcmenu :: !RightClickMenu
+ , notebook :: Notebook
-- other
+ , fprop :: !FilePropertyGrid
, settings :: !(TVar FMSettings)
+
+ , operationBuffer :: !(TVar FileOperation)
}
+
+-- |This describes the contents of the current vie and is separated from MyGUI,
+-- because we might want to have multiple views.
+data MyView = MkMyView {
+ view :: !(TVar FMView)
+ , cwd :: !(MVar Item)
+ , rawModel :: !(TVar (ListStore Item))
+ , sortedModel :: !(TVar (TypedTreeModelSort Item))
+ , filteredModel :: !(TVar (TypedTreeModelFilter Item))
+ , inotify :: !(MVar INotify)
+
+ -- 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]))
+
+ -- sub-widgets
+ , scroll :: !ScrolledWindow
+ , viewBox :: !Box
+ , rcmenu :: !RightClickMenu
+ , upViewB :: !Button
+ , homeViewB :: !Button
+ , refreshViewB :: !Button
+ , urlBar :: !Entry
+}
+
+
data MenuBar = MkMenuBar {
- menubarFileQuit :: !ImageMenuItem
- , menubarFileOpen :: !ImageMenuItem
- , menubarFileExecute :: !ImageMenuItem
- , menubarFileNew :: !ImageMenuItem
- , menubarEditCut :: !ImageMenuItem
- , menubarEditCopy :: !ImageMenuItem
- , menubarEditRename :: !ImageMenuItem
- , menubarEditPaste :: !ImageMenuItem
- , menubarEditDelete :: !ImageMenuItem
- , menubarViewTree :: !ImageMenuItem
- , menubarViewIcon :: !ImageMenuItem
- , menubarHelpAbout :: !ImageMenuItem
+ menubarFileQuit :: !ImageMenuItem
+ , menubarHelpAbout :: !ImageMenuItem
}
data RightClickMenu = MkRightClickMenu {
@@ -103,18 +113,20 @@ data RightClickMenu = MkRightClickMenu {
, rcFilePaste :: !ImageMenuItem
, rcFileDelete :: !ImageMenuItem
, rcFileProperty :: !ImageMenuItem
+ , rcFileIconView :: !ImageMenuItem
+ , rcFileTreeView :: !ImageMenuItem
}
data FilePropertyGrid = MkFilePropertyGrid {
- fpropGrid :: !Grid
- , fpropFnEntry :: !Entry
- , fpropLocEntry :: !Entry
- , fpropTsEntry :: !Entry
- , fpropModEntry :: !Entry
- , fpropAcEntry :: !Entry
- , fpropFTEntry :: !Entry
- , fpropPermEntry :: !Entry
- , fpropLDEntry :: !Entry
+ fpropGrid :: !Grid
+ , fpropFnEntry :: !Entry
+ , fpropLocEntry :: !Entry
+ , fpropTsEntry :: !Entry
+ , fpropModEntry :: !Entry
+ , fpropAcEntry :: !Entry
+ , fpropFTEntry :: !Entry
+ , fpropPermEntry :: !Entry
+ , fpropLDEntry :: !Entry
}
@@ -131,23 +143,8 @@ data FMView = FMTreeView !TreeView
type Item = File FileInfo
--- |This describes the contents of the current vie and is separated from MyGUI,
--- because we might want to have multiple views.
-data MyView = MkMyView {
- view :: !(TVar FMView)
- , cwd :: !(MVar Item)
- , rawModel :: !(TVar (ListStore Item))
- , sortedModel :: !(TVar (TypedTreeModelSort Item))
- , filteredModel :: !(TVar (TypedTreeModelFilter Item))
- , operationBuffer :: !(TVar FileOperation)
- , inotify :: !(MVar INotify)
-
- -- 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]))
-}
-
fmViewToContainer :: FMView -> Container
fmViewToContainer (FMTreeView x) = castToContainer . toGObject $ x
fmViewToContainer (FMIconView x) = castToContainer . toGObject $ x
+
diff --git a/src/HSFM/GUI/Gtk/MyGUI.hs b/src/HSFM/GUI/Gtk/MyGUI.hs
index fb0f11e..5dbb044 100644
--- a/src/HSFM/GUI/Gtk/MyGUI.hs
+++ b/src/HSFM/GUI/Gtk/MyGUI.hs
@@ -27,6 +27,7 @@ import Control.Concurrent.STM
newTVarIO
)
import Graphics.UI.Gtk
+import HSFM.FileSystem.FileOperations
import HSFM.GUI.Gtk.Data
import Paths_hsfm
(
@@ -47,6 +48,7 @@ createMyGUI = do
let settings' = MkFMSettings False True 24
settings <- newTVarIO settings'
+ operationBuffer <- newTVarIO None
builder <- builderNew
builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
@@ -54,66 +56,14 @@ createMyGUI = do
-- 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"
- rcFileNewRegFile <- builderGetObject builder castToImageMenuItem
- "rcFileNewRegFile"
- rcFileNewDir <- builderGetObject builder castToImageMenuItem
- "rcFileNewDir"
- 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"
- rcFileProperty <- builderGetObject builder castToImageMenuItem
- "rcFileProperty"
- upViewB <- builderGetObject builder castToButton
- "upViewB"
- homeViewB <- builderGetObject builder castToButton
- "homeViewB"
- refreshViewB <- builderGetObject builder castToButton
- "refreshViewB"
- menubarViewTree <- builderGetObject builder castToImageMenuItem
- "menubarViewTree"
- menubarViewIcon <- builderGetObject builder castToImageMenuItem
- "menubarViewIcon"
fpropGrid <- builderGetObject builder castToGrid
"fpropGrid"
fpropFnEntry <- builderGetObject builder castToEntry
@@ -132,10 +82,11 @@ createMyGUI = do
"fpropPermEntry"
fpropLDEntry <- builderGetObject builder castToEntry
"fpropLDEntry"
+ notebook <- builderGetObject builder castToNotebook
+ "notebook"
-- construct the gui object
let menubar = MkMenuBar {..}
- let rcmenu = MkRightClickMenu {..}
let fprop = MkFilePropertyGrid {..}
let mygui = MkMyGUI {..}
diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs
index 13e4f9c..79854fd 100644
--- a/src/HSFM/GUI/Gtk/MyView.hs
+++ b/src/HSFM/GUI/Gtk/MyView.hs
@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
-{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
@@ -53,20 +52,23 @@ import HSFM.FileSystem.Errors
canOpenDirectory
)
import Graphics.UI.Gtk
-import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setCallbacks)
+import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setViewCallbacks)
import HPath
(
Path
, Abs
)
import qualified HPath as P
-import HSFM.FileSystem.FileOperations
import HSFM.FileSystem.FileType
import HSFM.GUI.Glib.GlibString()
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Icons
import HSFM.GUI.Gtk.Utils
import HSFM.Utils.IO
+import Paths_hsfm
+ (
+ getDataFileName
+ )
import Prelude hiding(readFile)
import System.INotify.ByteString
(
@@ -78,6 +80,15 @@ import System.INotify.ByteString
+-- |Creates a new tab with its own view and refreshes the view.
+newTab :: MyGUI -> IO FMView -> Path Abs -> IO MyView
+newTab mygui iofmv path = do
+ myview <- createMyView mygui iofmv
+ _ <- notebookAppendPage (notebook mygui) (viewBox myview)
+ (maybe (P.fromAbs path) P.fromRel $ P.basename path)
+ refreshView mygui myview (Just path)
+ return myview
+
-- |Constructs the initial MyView object with a few dummy models.
-- It also initializes the callbacks.
@@ -85,11 +96,12 @@ createMyView :: MyGUI
-> IO FMView
-> IO MyView
createMyView mygui iofmv = do
- operationBuffer <- newTVarIO None
-
inotify <- newEmptyMVar
history <- newTVarIO ([],[])
+ builder <- builderNew
+ builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
+
-- create dummy models, so we don't have to use MVar
rawModel <- newTVarIO =<< listStoreNew []
filteredModel <- newTVarIO =<< (\x -> treeModelFilterNew x [])
@@ -100,14 +112,56 @@ createMyView mygui iofmv = do
view' <- iofmv
view <- newTVarIO view'
+ urlBar <- builderGetObject builder castToEntry
+ "urlBar"
+ rcMenu <- builderGetObject builder castToMenu
+ "rcMenu"
+ rcFileOpen <- builderGetObject builder castToImageMenuItem
+ "rcFileOpen"
+ rcFileExecute <- builderGetObject builder castToImageMenuItem
+ "rcFileExecute"
+ rcFileNewRegFile <- builderGetObject builder castToImageMenuItem
+ "rcFileNewRegFile"
+ rcFileNewDir <- builderGetObject builder castToImageMenuItem
+ "rcFileNewDir"
+ 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"
+ rcFileProperty <- builderGetObject builder castToImageMenuItem
+ "rcFileProperty"
+ rcFileIconView <- builderGetObject builder castToImageMenuItem
+ "rcFileIconView"
+ rcFileTreeView <- builderGetObject builder castToImageMenuItem
+ "rcFileTreeView"
+ upViewB <- builderGetObject builder castToButton
+ "upViewB"
+ homeViewB <- builderGetObject builder castToButton
+ "homeViewB"
+ refreshViewB <- builderGetObject builder castToButton
+ "refreshViewB"
+ scroll <- builderGetObject builder castToScrolledWindow
+ "mainScroll"
+ viewBox <- builderGetObject builder castToBox
+ "viewBox"
+
+ let rcmenu = MkRightClickMenu {..}
let myview = MkMyView {..}
-- set the bindings
- setCallbacks mygui myview
+ setViewCallbacks mygui myview
-- add the treeview to the scroll container
let oview = fmViewToContainer view'
- containerAdd (scroll mygui) oview
+ containerAdd scroll oview
+
+ widgetShowAll viewBox
return myview
@@ -116,22 +170,41 @@ createMyView mygui iofmv = do
-- io action returns.
switchView :: MyGUI -> MyView -> IO FMView -> IO ()
switchView mygui myview iofmv = do
+ cwd <- getCurrentDir myview
+
+ oldpage <- destroyView mygui myview
+
+ -- create new view and tab page where the previous one was
+ nview <- createMyView mygui iofmv
+ newpage <- notebookInsertPage (notebook mygui) (viewBox nview)
+ (maybe (P.fromAbs $ path cwd) P.fromRel
+ $ P.basename . path $ cwd) oldpage
+ notebookSetCurrentPage (notebook mygui) newpage
+
+ refreshView' mygui nview cwd
+
+
+-- |Destroys the current view by disconnecting the watcher
+-- and destroying the active FMView container.
+--
+-- Everything that needs to be done in order to forget about a
+-- view needs to be done here.
+--
+-- Returns the page in the tab list this view corresponds to.
+destroyView :: MyGUI -> MyView -> IO Int
+destroyView mygui myview = do
+ -- disconnect watcher
+ mi <- tryTakeMVar (inotify myview)
+ for_ mi $ \i -> killINotify i
+
+ page <- notebookGetCurrentPage (notebook mygui)
+
+ -- destroy old view and tab page
view' <- readTVarIO $ view myview
- let oview = fmViewToContainer view'
+ widgetDestroy (fmViewToContainer view')
+ notebookRemovePage (notebook mygui) page
- 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
+ return page
-- |Createss an IconView.
@@ -231,7 +304,7 @@ refreshView mygui myview mfp =
Item)
case ecd of
Right dir -> return (Just $ path dir)
- Left _ -> return (P.parseAbs "/")
+ Left _ -> return (P.parseAbs P.pathSeparator')
-- |Refreshes the View based on the given directory.
@@ -242,14 +315,14 @@ refreshView' :: MyGUI
-> MyView
-> Item
-> IO ()
-refreshView' mygui myview dt@(DirOrSym _) = do
- newRawModel <- fileListStore dt myview
+refreshView' mygui myview item@(DirOrSym _) = do
+ newRawModel <- fileListStore item myview
writeTVarIO (rawModel myview) newRawModel
view' <- readTVarIO $ view myview
_ <- tryTakeMVar (cwd myview)
- putMVar (cwd myview) dt
+ putMVar (cwd myview) item
-- get selected items
tps <- getSelectedTreePaths mygui myview
@@ -257,6 +330,12 @@ refreshView' mygui myview dt@(DirOrSym _) = do
constructView mygui myview
+ -- set notebook tab label
+ page <- notebookGetCurrentPage (notebook mygui)
+ child <- fromJust <$> notebookGetNthPage (notebook mygui) page
+ notebookSetTabLabelText (notebook mygui) child
+ (maybe (P.fromAbs $ path item) P.fromRel $ P.basename . path $ item)
+
-- reselect selected items
-- TODO: not implemented for icon view yet
case view' of
@@ -301,7 +380,7 @@ constructView mygui myview = do
cdirp <- path <$> getCurrentDir myview
-- update urlBar
- entrySetText (urlBar mygui) (P.fromAbs cdirp)
+ entrySetText (urlBar myview) (P.fromAbs cdirp)
rawModel' <- readTVarIO $ rawModel myview
diff --git a/src/HSFM/GUI/Gtk/Utils.hs b/src/HSFM/GUI/Gtk/Utils.hs
index 07902ab..e64b3c0 100644
--- a/src/HSFM/GUI/Gtk/Utils.hs
+++ b/src/HSFM/GUI/Gtk/Utils.hs
@@ -107,6 +107,9 @@ getFirstItem myview = do
-- |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)