hasufell/hsfm
1
1
Fork 0
Code Issues 33 Pull Requests Releases Wiki Activity

GTK: have two panels, fixes #52

Browse Source
This commit is contained in:
Julian Ospald 2016-11-06 01:33:03 +01:00
parent b495b3e89f
commit e2bf4d5f03
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
7 changed files with 360 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

157
data/Gtk/builder.xml
View File

@ -1,5 +1,5 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<!-- Generated with glade 3.18.3 --> <!-- Generated with glade 3.20.0 -->
<interface> <interface>
<requires lib="gtk+" version="3.16"/> <requires lib="gtk+" version="3.16"/>
<object class="GtkGrid" id="fpropGrid"> <object class="GtkGrid" id="fpropGrid">
@ -361,7 +361,15 @@
</packing> </packing>
</child> </child>
<child> <child>
<object class="GtkNotebook" id="notebook"> <object class="GtkBox">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
<object class="GtkPaned">
<property name="visible">True</property>
<property name="can_focus">True</property>
<child>
<object class="GtkNotebook" id="notebook1">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">True</property> <property name="can_focus">True</property>
<property name="scrollable">True</property> <property name="scrollable">True</property>
@ -384,16 +392,92 @@
<placeholder/> <placeholder/>
</child> </child>
</object> </object>
<packing>
<property name="resize">True</property>
<property name="shrink">True</property>
</packing>
</child>
<child>
<object class="GtkNotebook" id="notebook2">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="scrollable">True</property>
<child>
<placeholder/>
</child>
<child type="tab">
<placeholder/>
</child>
<child>
<placeholder/>
</child>
<child type="tab">
<placeholder/>
</child>
<child>
<placeholder/>
</child>
<child type="tab">
<placeholder/>
</child>
</object>
<packing>
<property name="resize">True</property>
<property name="shrink">True</property>
</packing>
</child>
</object>
<packing> <packing>
<property name="expand">True</property> <property name="expand">True</property>
<property name="fill">True</property> <property name="fill">True</property>
<property name="position">2</property> <property name="position">2</property>
</packing> </packing>
</child> </child>
</object>
<packing>
<property name="expand">True</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
<child> <child>
<object class="GtkBox" id="box3"> <object class="GtkBox" id="box3">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<child>
<object class="GtkToggleButton" id="leftNbBtn">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="receives_default">True</property>
<property name="margin_left">5</property>
<property name="margin_right">5</property>
<property name="margin_top">5</property>
<property name="margin_bottom">5</property>
<property name="relief">none</property>
<property name="always_show_image">True</property>
<child>
<placeholder/>
</child>
</object>
<packing>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="position">0</property>
</packing>
</child>
<child>
<object class="GtkSeparator">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="margin_left">2</property>
<property name="margin_right">2</property>
</object>
<packing>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="position">1</property>
</packing>
</child>
<child> <child>
<object class="GtkStatusbar" id="statusBar"> <object class="GtkStatusbar" id="statusBar">
<property name="visible">True</property> <property name="visible">True</property>
@ -410,7 +494,7 @@
<packing> <packing>
<property name="expand">True</property> <property name="expand">True</property>
<property name="fill">True</property> <property name="fill">True</property>
<property name="position">0</property> <property name="position">2</property>
</packing> </packing>
</child> </child>
<child> <child>
@ -427,14 +511,48 @@
<packing> <packing>
<property name="expand">False</property> <property name="expand">False</property>
<property name="fill">True</property> <property name="fill">True</property>
<property name="position">1</property> <property name="position">3</property>
</packing>
</child>
<child>
<object class="GtkSeparator">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="margin_left">2</property>
<property name="margin_right">2</property>
</object>
<packing>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="position">4</property>
</packing>
</child>
<child>
<object class="GtkToggleButton" id="rightNbBtn">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="receives_default">True</property>
<property name="margin_left">5</property>
<property name="margin_right">5</property>
<property name="margin_top">5</property>
<property name="margin_bottom">5</property>
<property name="relief">none</property>
<property name="always_show_image">True</property>
<child>
<placeholder/>
</child>
</object>
<packing>
<property name="expand">False</property>
<property name="fill">True</property>
<property name="position">5</property>
</packing> </packing>
</child> </child>
</object> </object>
<packing> <packing>
<property name="expand">False</property> <property name="expand">False</property>
<property name="fill">True</property> <property name="fill">True</property>
<property name="position">3</property> <property name="position">2</property>
</packing> </packing>
</child> </child>
</object> </object>
@ -460,6 +578,16 @@
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="stock">gtk-zoom-fit</property> <property name="stock">gtk-zoom-fit</property>
</object> </object>
<object class="GtkImage" id="image8">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="stock">gtk-add</property>
</object>
<object class="GtkImage" id="image9">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="icon_name">utilities-terminal</property>
</object>
<object class="GtkMenu" id="rcMenu"> <object class="GtkMenu" id="rcMenu">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
@ -567,7 +695,6 @@
<property name="label">Rename</property> <property name="label">Rename</property>
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="image">image1</property>
<property name="use_stock">False</property> <property name="use_stock">False</property>
</object> </object>
</child> </child>
@ -638,20 +765,24 @@
</object> </object>
</child> </child>
</object> </object>
<object class="GtkImage" id="image8"> <object class="GtkImage" id="leftNbIcon">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="stock">gtk-add</property> <property name="stock">gtk-yes</property>
</object> </object>
<object class="GtkImage" id="image9"> <object class="GtkImage" id="rightNbIcon">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="icon_name">utilities-terminal</property> <property name="stock">gtk-yes</property>
</object> </object>
<object class="GtkBox" id="viewBox"> <object class="GtkBox" id="viewBox">
<property name="visible">True</property> <property name="visible">True</property>
<property name="can_focus">False</property> <property name="can_focus">False</property>
<property name="orientation">vertical</property> <property name="orientation">vertical</property>
<child>
<object class="GtkEventBox" id="viewEventBox">
<property name="visible">True</property>
<property name="can_focus">False</property>
<child> <child>
<object class="GtkBox" id="box2"> <object class="GtkBox" id="box2">
<property name="visible">True</property> <property name="visible">True</property>
@ -768,10 +899,12 @@
</packing> </packing>
</child> </child>
</object> </object>
</child>
</object>
<packing> <packing>
<property name="expand">False</property> <property name="expand">False</property>
<property name="fill">True</property> <property name="fill">True</property>
<property name="position">0</property> <property name="position">1</property>
</packing> </packing>
</child> </child>
<child> <child>
@ -788,7 +921,7 @@
<packing> <packing>
<property name="expand">True</property> <property name="expand">True</property>
<property name="fill">True</property> <property name="fill">True</property>
<property name="position">1</property> <property name="position">2</property>
</packing> </packing>
</child> </child>
</object> </object>

3
src/HSFM/GUI/Gtk.hs
View File

@ -57,7 +57,8 @@ main = do
_ <- initGUI _ <- initGUI
mygui <- createMyGUI mygui <- createMyGUI
_ <- newTab mygui createTreeView file (-1) _ <- newTab mygui (notebook1 mygui) createTreeView file (-1)
_ <- newTab mygui (notebook2 mygui) createTreeView file (-1)
setGUICallbacks mygui setGUICallbacks mygui

46
src/HSFM/GUI/Gtk/Callbacks.hs
View File

@ -121,6 +121,18 @@ import Paths_hsfm
setGUICallbacks :: MyGUI -> IO () setGUICallbacks :: MyGUI -> IO ()
setGUICallbacks mygui = do setGUICallbacks mygui = do
-- notebook toggle buttons
_ <- leftNbBtn mygui `on` toggled $ do
isPressed <- toggleButtonGetActive $ leftNbBtn mygui
if isPressed then widgetShow $ notebook1 mygui
else widgetHide $ notebook1 mygui
_ <- rightNbBtn mygui `on` toggled $ do
isPressed <- toggleButtonGetActive $ rightNbBtn mygui
if isPressed then widgetShow $ notebook2 mygui
else widgetHide $ notebook2 mygui
-- statusbar
_ <- clearStatusBar mygui `on` buttonActivated $ do _ <- clearStatusBar mygui `on` buttonActivated $ do
popStatusbar mygui popStatusbar mygui
writeTVarIO (operationBuffer mygui) None writeTVarIO (operationBuffer mygui) None
@ -192,6 +204,16 @@ setViewCallbacks mygui myview = do
commonGuiEvents fmv = do commonGuiEvents fmv = do
let view = fmViewToContainer fmv let view = fmViewToContainer fmv
-- focus events
_ <- notebook1 mygui `on` setFocusChild $ \w ->
case w of
Nothing -> widgetSetSensitive (leftNbIcon mygui) False
_ -> widgetSetSensitive (leftNbIcon mygui) True
_ <- notebook2 mygui `on` setFocusChild $ \w ->
case w of
Nothing -> widgetSetSensitive (rightNbIcon mygui) False
_ -> widgetSetSensitive (rightNbIcon mygui) True
-- GUI events -- GUI events
_ <- backViewB myview `on` buttonPressEvent $ do _ <- backViewB myview `on` buttonPressEvent $ do
eb <- eventButton eb <- eventButton
@ -315,7 +337,7 @@ setViewCallbacks mygui myview = do
-- if the item under the cursor is not within the current -- if the item under the cursor is not within the current
-- selection -- selection
(Just item) -> do (Just item) -> do
liftIO $ opeInNewTab mygui item liftIO $ opeInNewTab mygui myview item
return True return True
-- no item under the cursor, pass on the signal -- no item under the cursor, pass on the signal
Nothing -> return False Nothing -> return False
@ -358,21 +380,23 @@ openTerminalHere myview = do
-- |Closes the current tab, but only if there is more than one tab. -- |Closes the current tab, but only if there is more than one tab.
closeTab :: MyGUI -> MyView -> IO () closeTab :: MyGUI -> MyView -> IO ()
closeTab mygui myview = do closeTab _ myview = do
n <- notebookGetNPages (notebook mygui) n <- notebookGetNPages (notebook myview)
when (n > 1) $ void $ destroyView mygui myview when (n > 1) $ void $ destroyView myview
newTab' :: MyGUI -> MyView -> IO () newTab' :: MyGUI -> MyView -> IO ()
newTab' mygui myview = do newTab' mygui myview = do
cwd <- getCurrentDir myview cwd <- getCurrentDir myview
void $ withErrorDialog $ newTab mygui createTreeView cwd (-1) void $ withErrorDialog
$ newTab mygui (notebook myview) createTreeView cwd (-1)
opeInNewTab :: MyGUI -> Item -> IO () opeInNewTab :: MyGUI -> MyView -> Item -> IO ()
opeInNewTab mygui item@(DirOrSym _) = opeInNewTab mygui myview item@(DirOrSym _) =
void $ withErrorDialog $ newTab mygui createTreeView item (-1) void $ withErrorDialog
opeInNewTab _ _ = return () $ newTab mygui (notebook myview) createTreeView item (-1)
opeInNewTab _ _ _ = return ()
@ -532,10 +556,10 @@ open [item] mygui myview = withErrorDialog $
goDir True mygui myview nv goDir True mygui myview nv
r -> r ->
void $ openFile . path $ r void $ openFile . path $ r
open items mygui _ = do open items mygui myview = do
let dirs = filter (fst . sdir) items let dirs = filter (fst . sdir) items
files = filter (fst . sfileLike) items files = filter (fst . sfileLike) items
forM_ dirs (withErrorDialog . opeInNewTab mygui) forM_ dirs (withErrorDialog . opeInNewTab mygui myview)
forM_ files (withErrorDialog . openFile . path) forM_ files (withErrorDialog . openFile . path)

6
src/HSFM/GUI/Gtk/Callbacks/Utils.hs
View File

@ -115,12 +115,12 @@ goDir bhis mygui myview item = do
refreshView mygui myview item refreshView mygui myview item
-- set notebook tab label -- set notebook tab label
page <- notebookGetCurrentPage (notebook mygui) page <- notebookGetCurrentPage (notebook myview)
child <- fromJust <$> notebookGetNthPage (notebook mygui) page child <- fromJust <$> notebookGetNthPage (notebook myview) page
-- get the label -- get the label
ebox <- (castToEventBox . fromJust) ebox <- (castToEventBox . fromJust)
<$> notebookGetTabLabel (notebook mygui) child <$> notebookGetTabLabel (notebook myview) child
label <- (castToLabel . head) <$> containerGetChildren ebox label <- (castToLabel . head) <$> containerGetChildren ebox
-- set the label -- set the label

10
src/HSFM/GUI/Gtk/Data.hs
View File

@ -57,7 +57,14 @@ data MyGUI = MkMyGUI {
, menubar :: !MenuBar , menubar :: !MenuBar
, statusBar :: !Statusbar , statusBar :: !Statusbar
, clearStatusBar :: !Button , clearStatusBar :: !Button
, notebook :: !Notebook
, notebook1 :: !Notebook
, leftNbBtn :: !ToggleButton
, leftNbIcon :: !Image
, notebook2 :: !Notebook
, rightNbBtn :: !ToggleButton
, rightNbIcon :: !Image
-- other -- other
, fprop :: !FilePropertyGrid , fprop :: !FilePropertyGrid
@ -76,6 +83,7 @@ data MyView = MkMyView {
, sortedModel :: !(TVar (TypedTreeModelSort Item)) , sortedModel :: !(TVar (TypedTreeModelSort Item))
, filteredModel :: !(TVar (TypedTreeModelFilter Item)) , filteredModel :: !(TVar (TypedTreeModelFilter Item))
, inotify :: !(MVar INotify) , inotify :: !(MVar INotify)
, notebook :: !Notebook -- current notebook
-- 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

26
src/HSFM/GUI/Gtk/MyGUI.hs
View File

@ -81,12 +81,32 @@ createMyGUI = do
"fpropPermEntry" "fpropPermEntry"
fpropLDEntry <- builderGetObject builder castToEntry fpropLDEntry <- builderGetObject builder castToEntry
"fpropLDEntry" "fpropLDEntry"
notebook <- builderGetObject builder castToNotebook notebook1 <- builderGetObject builder castToNotebook
"notebook" "notebook1"
notebook2 <- builderGetObject builder castToNotebook
"notebook2"
leftNbIcon <- builderGetObject builder castToImage
"leftNbIcon"
rightNbIcon <- builderGetObject builder castToImage
"rightNbIcon"
leftNbBtn <- builderGetObject builder castToToggleButton
"leftNbBtn"
rightNbBtn <- builderGetObject builder castToToggleButton
"rightNbBtn"
-- this is required so that hotkeys work as expected, because -- this is required so that hotkeys work as expected, because
-- we then can connect to signals from `viewBox` more reliably -- we then can connect to signals from `viewBox` more reliably
widgetSetCanFocus notebook False widgetSetCanFocus notebook1 False
widgetSetCanFocus notebook2 False
-- notebook toggle buttons
buttonSetImage leftNbBtn leftNbIcon
buttonSetImage rightNbBtn rightNbIcon
widgetSetSensitive leftNbIcon False
widgetSetSensitive rightNbIcon False
toggleButtonSetActive leftNbBtn True
toggleButtonSetActive rightNbBtn True
-- construct the gui object -- construct the gui object
let menubar = MkMenuBar {..} let menubar = MkMenuBar {..}

36
src/HSFM/GUI/Gtk/MyView.hs
View File

@ -92,8 +92,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 -> Notebook -> IO FMView -> Item -> Int -> IO MyView
newTab mygui iofmv item pos = do newTab mygui nb iofmv item pos = do
-- create eventbox with label -- create eventbox with label
@ -104,8 +104,8 @@ newTab mygui iofmv item pos = do
containerAdd ebox label containerAdd ebox label
widgetShowAll label widgetShowAll label
myview <- createMyView mygui iofmv myview <- createMyView mygui nb iofmv
_ <- notebookInsertPageMenu (notebook mygui) (viewBox myview) _ <- notebookInsertPageMenu (notebook myview) (viewBox myview)
ebox ebox pos ebox ebox pos
-- set initial history -- set initial history
@ -113,7 +113,7 @@ newTab mygui iofmv item pos = do
putMVar (history myview) putMVar (history myview)
(BrowsingHistory [] (path item) [] historySize) (BrowsingHistory [] (path item) [] historySize)
notebookSetTabReorderable (notebook mygui) (viewBox myview) True notebookSetTabReorderable (notebook myview) (viewBox myview) True
catchIOError (refreshView mygui myview item) $ \e -> do catchIOError (refreshView mygui myview item) $ \e -> do
file <- readFile getFileInfo . fromJust . P.parseAbs . fromString file <- readFile getFileInfo . fromJust . P.parseAbs . fromString
@ -127,8 +127,8 @@ newTab mygui iofmv item pos = do
eb <- eventButton eb <- eventButton
case eb of case eb of
MiddleButton -> liftIO $ do MiddleButton -> liftIO $ do
n <- notebookGetNPages (notebook mygui) n <- notebookGetNPages (notebook myview)
when (n > 1) $ void $ destroyView mygui myview when (n > 1) $ void $ destroyView myview
return True return True
_ -> return False _ -> return False
@ -138,9 +138,10 @@ newTab mygui iofmv item pos = do
-- |Constructs the initial MyView object with a few dummy models. -- |Constructs the initial MyView object with a few dummy models.
-- It also initializes the callbacks. -- It also initializes the callbacks.
createMyView :: MyGUI createMyView :: MyGUI
-> Notebook
-> IO FMView -> IO FMView
-> IO MyView -> IO MyView
createMyView mygui iofmv = do createMyView mygui nb iofmv = do
inotify <- newEmptyMVar inotify <- newEmptyMVar
history <- newEmptyMVar history <- newEmptyMVar
@ -175,6 +176,7 @@ createMyView mygui iofmv = do
viewBox <- builderGetObject builder castToBox viewBox <- builderGetObject builder castToBox
"viewBox" "viewBox"
let notebook = nb
let myview = MkMyView {..} let myview = MkMyView {..}
-- set the bindings -- set the bindings
@ -195,13 +197,15 @@ switchView :: MyGUI -> MyView -> IO FMView -> IO ()
switchView mygui myview iofmv = do switchView mygui myview iofmv = do
cwd <- getCurrentDir myview cwd <- getCurrentDir myview
oldpage <- destroyView mygui myview let nb = notebook myview
oldpage <- destroyView myview
-- create new view and tab page where the previous one was -- create new view and tab page where the previous one was
nview <- newTab mygui iofmv cwd oldpage nview <- newTab mygui nb iofmv cwd oldpage
page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox nview) page <- fromJust <$> notebookPageNum nb (viewBox nview)
notebookSetCurrentPage (notebook mygui) page notebookSetCurrentPage nb page
refreshView mygui nview cwd refreshView mygui nview cwd
@ -213,18 +217,18 @@ switchView mygui myview iofmv = do
-- view needs to be done here. -- view needs to be done here.
-- --
-- Returns the page in the tab list this view corresponds to. -- Returns the page in the tab list this view corresponds to.
destroyView :: MyGUI -> MyView -> IO Int destroyView :: MyView -> IO Int
destroyView mygui myview = do destroyView myview = do
-- disconnect watcher -- disconnect watcher
mi <- tryTakeMVar (inotify myview) mi <- tryTakeMVar (inotify myview)
for_ mi $ \i -> killINotify i for_ mi $ \i -> killINotify i
page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox myview) page <- fromJust <$> notebookPageNum (notebook myview) (viewBox myview)
-- destroy old view and tab page -- destroy old view and tab page
view' <- readTVarIO $ view myview view' <- readTVarIO $ view myview
widgetDestroy (fmViewToContainer view') widgetDestroy (fmViewToContainer view')
notebookRemovePage (notebook mygui) page notebookRemovePage (notebook myview) page
return page return page