use haskell-gi bugfix to improve tab reordering

This commit is contained in:
sheaf 2020-09-26 00:21:49 +02:00
parent 58ca70c1bd
commit a5ba7dcd33
3 changed files with 20 additions and 10 deletions

5
.gitignore vendored
View file

@ -3,9 +3,10 @@ cabal.project.local
assets/*.svg assets/*.svg
assets/*/ assets/*/
refs/
img/examples
files/ files/
img/examples
math/
refs/
*.txt *.txt
*.md *.md

View file

@ -29,3 +29,9 @@ source-repository-package
type: git type: git
location: https://github.com/sheaf/waargonaut location: https://github.com/sheaf/waargonaut
tag: dc835fb86d2592fa2e55753fa4eb7c59d6124699 tag: dc835fb86d2592fa2e55753fa4eb7c59d6124699
-- haskell-gi: add fix for GValue
source-repository-package
type: git
location: https://github.com/haskell-gi/haskell-gi
tag: 6fe7fc271095b5b6115b142f72995ebc11840afb

View file

@ -18,6 +18,8 @@ import Control.Monad
( join, unless, void ) ( join, unless, void )
import Data.Foldable import Data.Foldable
( for_, sequenceA_ ) ( for_, sequenceA_ )
import Data.Functor
( (<&>) )
import Data.Traversable import Data.Traversable
( for ) ( for )
@ -32,6 +34,10 @@ import qualified GI.Cairo.Render.Connector as Cairo
-- gi-gtk -- gi-gtk
import qualified GI.Gtk as GTK import qualified GI.Gtk as GTK
-- haskell-gi-base
import qualified Data.GI.Base.GValue as GI
import qualified Data.GI.Base.GType as GI
-- stm -- stm
import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM as STM
( atomically ) ( atomically )
@ -134,7 +140,7 @@ newFileTab
widgetAddClasses closeFileButton [ "fileBarCloseButton" ] widgetAddClasses closeFileButton [ "fileBarCloseButton" ]
GTK.widgetShowAll tab GTK.widgetShowAll tab
-- We've placed the new tab at the end. Now rearrange it if needed. -- We've placed the new tab at the end. Now rearrange it if necessary.
case newTabLoc of case newTabLoc of
LastTab -> pure () LastTab -> pure ()
AfterCurrentTab -> do AfterCurrentTab -> do
@ -143,13 +149,10 @@ newFileTab
for mbUnique \ docUnique -> do for mbUnique \ docUnique -> do
Map.lookup docUnique <$> STM.readTVar fileBarTabsTVar Map.lookup docUnique <$> STM.readTVar fileBarTabsTVar
for_ mbActiveTab \ ( activeTab, _ ) -> do for_ mbActiveTab \ ( activeTab, _ ) -> do
children <- GTK.containerGetChildren fileTabsBox gValue <- GI.newGValue GI.gtypeInt
for_ ( zip children [0..] ) \ ( childWidget, activeTabIndex ) -> do GTK.containerChildGetProperty fileTabsBox activeTab "position" gValue
mbBox <- GTK.castTo GTK.Box childWidget ( GI.get_int gValue <&> ( +1 ) ) >>= GI.set_int gValue
for_ mbBox \ box -> GTK.containerChildSetProperty fileTabsBox tab "position" gValue
if box == activeTab
then GTK.boxReorderChild fileTabsBox tab ( activeTabIndex + 1 )
else pure ()
-- Ensure consistency of hover/selection state between the two elements in the tab. -- Ensure consistency of hover/selection state between the two elements in the tab.
for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do