GTK: have two panels, fixes #52
This commit is contained in:
parent
b495b3e89f
commit
e2bf4d5f03
|
|
@ -1,5 +1,5 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!-- Generated with glade 3.18.3 -->
|
||||
<!-- Generated with glade 3.20.0 -->
|
||||
<interface>
|
||||
<requires lib="gtk+" version="3.16"/>
|
||||
<object class="GtkGrid" id="fpropGrid">
|
||||
|
|
@ -361,39 +361,123 @@
|
|||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkNotebook" id="notebook">
|
||||
<object class="GtkBox">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="scrollable">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<child>
|
||||
<placeholder/>
|
||||
</child>
|
||||
<child type="tab">
|
||||
<placeholder/>
|
||||
</child>
|
||||
<child>
|
||||
<placeholder/>
|
||||
</child>
|
||||
<child type="tab">
|
||||
<placeholder/>
|
||||
</child>
|
||||
<child>
|
||||
<placeholder/>
|
||||
</child>
|
||||
<child type="tab">
|
||||
<placeholder/>
|
||||
<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="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>
|
||||
<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>
|
||||
<property name="expand">True</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">True</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">2</property>
|
||||
<property name="position">1</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkBox" id="box3">
|
||||
<property name="visible">True</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>
|
||||
<object class="GtkStatusbar" id="statusBar">
|
||||
<property name="visible">True</property>
|
||||
|
|
@ -410,7 +494,7 @@
|
|||
<packing>
|
||||
<property name="expand">True</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">0</property>
|
||||
<property name="position">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
|
|
@ -427,14 +511,48 @@
|
|||
<packing>
|
||||
<property name="expand">False</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>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">3</property>
|
||||
<property name="position">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
</object>
|
||||
|
|
@ -460,6 +578,16 @@
|
|||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-zoom-fit</property>
|
||||
</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">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
|
|
@ -567,7 +695,6 @@
|
|||
<property name="label">Rename</property>
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="image">image1</property>
|
||||
<property name="use_stock">False</property>
|
||||
</object>
|
||||
</child>
|
||||
|
|
@ -638,140 +765,146 @@
|
|||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<object class="GtkImage" id="image8">
|
||||
<object class="GtkImage" id="leftNbIcon">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-add</property>
|
||||
<property name="stock">gtk-yes</property>
|
||||
</object>
|
||||
<object class="GtkImage" id="image9">
|
||||
<object class="GtkImage" id="rightNbIcon">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="icon_name">utilities-terminal</property>
|
||||
<property name="stock">gtk-yes</property>
|
||||
</object>
|
||||
<object class="GtkBox" id="viewBox">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="orientation">vertical</property>
|
||||
<child>
|
||||
<object class="GtkBox" id="box2">
|
||||
<object class="GtkEventBox" id="viewEventBox">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<child>
|
||||
<object class="GtkButton" id="backViewB">
|
||||
<object class="GtkBox" id="box2">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageGoBack">
|
||||
<object class="GtkButton" id="backViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-go-back</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageGoBack">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-go-back</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">0</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="upViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageGoUp">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-go-up</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">1</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="forwardViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageGoForward">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-go-forward</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="refreshViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageRefresh">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-refresh</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">3</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="homeViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageHome">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-home</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">4</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkEntry" id="urlBar">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="input_purpose">url</property>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">True</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">5</property>
|
||||
</packing>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">0</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="upViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageGoUp">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-go-up</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">1</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="forwardViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageGoForward">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-go-forward</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="refreshViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageRefresh">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-refresh</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="padding">2</property>
|
||||
<property name="position">3</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkButton" id="homeViewB">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">True</property>
|
||||
<child>
|
||||
<object class="GtkImage" id="imageHome">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">False</property>
|
||||
<property name="stock">gtk-home</property>
|
||||
</object>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">4</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<object class="GtkEntry" id="urlBar">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="input_purpose">url</property>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">True</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">5</property>
|
||||
</packing>
|
||||
</child>
|
||||
</object>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">0</property>
|
||||
<property name="position">1</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
|
|
@ -788,7 +921,7 @@
|
|||
<packing>
|
||||
<property name="expand">True</property>
|
||||
<property name="fill">True</property>
|
||||
<property name="position">1</property>
|
||||
<property name="position">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
</object>
|
||||
|
|
|
|||
|
|
@ -57,7 +57,8 @@ main = do
|
|||
|
||||
_ <- initGUI
|
||||
mygui <- createMyGUI
|
||||
_ <- newTab mygui createTreeView file (-1)
|
||||
_ <- newTab mygui (notebook1 mygui) createTreeView file (-1)
|
||||
_ <- newTab mygui (notebook2 mygui) createTreeView file (-1)
|
||||
|
||||
setGUICallbacks mygui
|
||||
|
||||
|
|
|
|||
|
|
@ -121,6 +121,18 @@ import Paths_hsfm
|
|||
setGUICallbacks :: MyGUI -> IO ()
|
||||
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
|
||||
popStatusbar mygui
|
||||
writeTVarIO (operationBuffer mygui) None
|
||||
|
|
@ -192,6 +204,16 @@ setViewCallbacks mygui myview = do
|
|||
commonGuiEvents fmv = do
|
||||
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
|
||||
_ <- backViewB myview `on` buttonPressEvent $ do
|
||||
eb <- eventButton
|
||||
|
|
@ -315,7 +337,7 @@ setViewCallbacks mygui myview = do
|
|||
-- if the item under the cursor is not within the current
|
||||
-- selection
|
||||
(Just item) -> do
|
||||
liftIO $ opeInNewTab mygui item
|
||||
liftIO $ opeInNewTab mygui myview item
|
||||
return True
|
||||
-- no item under the cursor, pass on the signal
|
||||
Nothing -> return False
|
||||
|
|
@ -358,21 +380,23 @@ openTerminalHere myview = do
|
|||
|
||||
-- |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
|
||||
closeTab _ myview = do
|
||||
n <- notebookGetNPages (notebook myview)
|
||||
when (n > 1) $ void $ destroyView myview
|
||||
|
||||
|
||||
newTab' :: MyGUI -> MyView -> IO ()
|
||||
newTab' mygui myview = do
|
||||
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 item@(DirOrSym _) =
|
||||
void $ withErrorDialog $ newTab mygui createTreeView item (-1)
|
||||
opeInNewTab _ _ = return ()
|
||||
opeInNewTab :: MyGUI -> MyView -> Item -> IO ()
|
||||
opeInNewTab mygui myview item@(DirOrSym _) =
|
||||
void $ withErrorDialog
|
||||
$ newTab mygui (notebook myview) createTreeView item (-1)
|
||||
opeInNewTab _ _ _ = return ()
|
||||
|
||||
|
||||
|
||||
|
|
@ -532,10 +556,10 @@ open [item] mygui myview = withErrorDialog $
|
|||
goDir True mygui myview nv
|
||||
r ->
|
||||
void $ openFile . path $ r
|
||||
open items mygui _ = do
|
||||
open items mygui myview = do
|
||||
let dirs = filter (fst . sdir) items
|
||||
files = filter (fst . sfileLike) items
|
||||
forM_ dirs (withErrorDialog . opeInNewTab mygui)
|
||||
forM_ dirs (withErrorDialog . opeInNewTab mygui myview)
|
||||
forM_ files (withErrorDialog . openFile . path)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -115,12 +115,12 @@ goDir bhis mygui myview item = do
|
|||
refreshView mygui myview item
|
||||
|
||||
-- set notebook tab label
|
||||
page <- notebookGetCurrentPage (notebook mygui)
|
||||
child <- fromJust <$> notebookGetNthPage (notebook mygui) page
|
||||
page <- notebookGetCurrentPage (notebook myview)
|
||||
child <- fromJust <$> notebookGetNthPage (notebook myview) page
|
||||
|
||||
-- get the label
|
||||
ebox <- (castToEventBox . fromJust)
|
||||
<$> notebookGetTabLabel (notebook mygui) child
|
||||
<$> notebookGetTabLabel (notebook myview) child
|
||||
label <- (castToLabel . head) <$> containerGetChildren ebox
|
||||
|
||||
-- set the label
|
||||
|
|
|
|||
|
|
@ -57,7 +57,14 @@ data MyGUI = MkMyGUI {
|
|||
, menubar :: !MenuBar
|
||||
, statusBar :: !Statusbar
|
||||
, clearStatusBar :: !Button
|
||||
, notebook :: !Notebook
|
||||
|
||||
, notebook1 :: !Notebook
|
||||
, leftNbBtn :: !ToggleButton
|
||||
, leftNbIcon :: !Image
|
||||
|
||||
, notebook2 :: !Notebook
|
||||
, rightNbBtn :: !ToggleButton
|
||||
, rightNbIcon :: !Image
|
||||
|
||||
-- other
|
||||
, fprop :: !FilePropertyGrid
|
||||
|
|
@ -76,6 +83,7 @@ data MyView = MkMyView {
|
|||
, sortedModel :: !(TVar (TypedTreeModelSort Item))
|
||||
, filteredModel :: !(TVar (TypedTreeModelFilter Item))
|
||||
, inotify :: !(MVar INotify)
|
||||
, notebook :: !Notebook -- current notebook
|
||||
|
||||
-- the first part of the tuple represents the "go back"
|
||||
-- the second part the "go forth" in the history
|
||||
|
|
|
|||
|
|
@ -81,12 +81,32 @@ createMyGUI = do
|
|||
"fpropPermEntry"
|
||||
fpropLDEntry <- builderGetObject builder castToEntry
|
||||
"fpropLDEntry"
|
||||
notebook <- builderGetObject builder castToNotebook
|
||||
"notebook"
|
||||
notebook1 <- builderGetObject builder castToNotebook
|
||||
"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
|
||||
-- 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
|
||||
let menubar = MkMenuBar {..}
|
||||
|
|
|
|||
|
|
@ -92,8 +92,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
|
||||
newTab :: MyGUI -> Notebook -> IO FMView -> Item -> Int -> IO MyView
|
||||
newTab mygui nb iofmv item pos = do
|
||||
|
||||
|
||||
-- create eventbox with label
|
||||
|
|
@ -104,8 +104,8 @@ newTab mygui iofmv item pos = do
|
|||
containerAdd ebox label
|
||||
widgetShowAll label
|
||||
|
||||
myview <- createMyView mygui iofmv
|
||||
_ <- notebookInsertPageMenu (notebook mygui) (viewBox myview)
|
||||
myview <- createMyView mygui nb iofmv
|
||||
_ <- notebookInsertPageMenu (notebook myview) (viewBox myview)
|
||||
ebox ebox pos
|
||||
|
||||
-- set initial history
|
||||
|
|
@ -113,7 +113,7 @@ newTab mygui iofmv item pos = do
|
|||
putMVar (history myview)
|
||||
(BrowsingHistory [] (path item) [] historySize)
|
||||
|
||||
notebookSetTabReorderable (notebook mygui) (viewBox myview) True
|
||||
notebookSetTabReorderable (notebook myview) (viewBox myview) True
|
||||
|
||||
catchIOError (refreshView mygui myview item) $ \e -> do
|
||||
file <- readFile getFileInfo . fromJust . P.parseAbs . fromString
|
||||
|
|
@ -127,8 +127,8 @@ newTab mygui iofmv item pos = do
|
|||
eb <- eventButton
|
||||
case eb of
|
||||
MiddleButton -> liftIO $ do
|
||||
n <- notebookGetNPages (notebook mygui)
|
||||
when (n > 1) $ void $ destroyView mygui myview
|
||||
n <- notebookGetNPages (notebook myview)
|
||||
when (n > 1) $ void $ destroyView myview
|
||||
return True
|
||||
_ -> return False
|
||||
|
||||
|
|
@ -138,9 +138,10 @@ newTab mygui iofmv item pos = do
|
|||
-- |Constructs the initial MyView object with a few dummy models.
|
||||
-- It also initializes the callbacks.
|
||||
createMyView :: MyGUI
|
||||
-> Notebook
|
||||
-> IO FMView
|
||||
-> IO MyView
|
||||
createMyView mygui iofmv = do
|
||||
createMyView mygui nb iofmv = do
|
||||
inotify <- newEmptyMVar
|
||||
history <- newEmptyMVar
|
||||
|
||||
|
|
@ -175,6 +176,7 @@ createMyView mygui iofmv = do
|
|||
viewBox <- builderGetObject builder castToBox
|
||||
"viewBox"
|
||||
|
||||
let notebook = nb
|
||||
let myview = MkMyView {..}
|
||||
|
||||
-- set the bindings
|
||||
|
|
@ -195,13 +197,15 @@ switchView :: MyGUI -> MyView -> IO FMView -> IO ()
|
|||
switchView mygui myview iofmv = do
|
||||
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
|
||||
nview <- newTab mygui iofmv cwd oldpage
|
||||
nview <- newTab mygui nb iofmv cwd oldpage
|
||||
|
||||
page <- fromJust <$> notebookPageNum (notebook mygui) (viewBox nview)
|
||||
notebookSetCurrentPage (notebook mygui) page
|
||||
page <- fromJust <$> notebookPageNum nb (viewBox nview)
|
||||
notebookSetCurrentPage nb page
|
||||
|
||||
refreshView mygui nview cwd
|
||||
|
||||
|
|
@ -213,18 +217,18 @@ switchView mygui myview iofmv = do
|
|||
-- 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
|
||||
destroyView :: MyView -> IO Int
|
||||
destroyView myview = do
|
||||
-- disconnect watcher
|
||||
mi <- tryTakeMVar (inotify myview)
|
||||
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
|
||||
view' <- readTVarIO $ view myview
|
||||
widgetDestroy (fmViewToContainer view')
|
||||
notebookRemovePage (notebook mygui) page
|
||||
notebookRemovePage (notebook myview) page
|
||||
|
||||
return page
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue