diff --git a/app/Main.hs b/app/Main.hs index 702c443..33eeeb6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -21,6 +21,8 @@ import System.Exit -- containers import Data.Map.Strict ( Map ) +import qualified Data.Map.Strict as Map + ( empty ) import Data.Sequence ( Seq(..) ) import qualified Data.Sequence as Seq @@ -187,6 +189,7 @@ main = do toolTVar <- STM.newTVarIO @Tool Selection modeTVar <- STM.newTVarIO @Mode Path partialPathTVar <- STM.newTVarIO @( Maybe PartialPath ) Nothing + fileBarTabsTVar <- STM.newTVarIO @( Map Unique GTK.Box ) Map.empty -- Put all these stateful variables in a record for conciseness. let diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs index 377bddd..f17888c 100644 --- a/src/app/MetaBrush/Action.hs +++ b/src/app/MetaBrush/Action.hs @@ -36,7 +36,7 @@ import Data.Act -- containers import qualified Data.Map as Map - ( lookup, insert, delete ) + ( lookup, insert ) import Data.Sequence ( Seq(..) ) import qualified Data.Sequence as Seq @@ -76,6 +76,7 @@ import MetaBrush.Context , Modifier(..), modifierKey , HoldAction(..), PartialPath(..) , currentDocument, withCurrentDocument, modifyingCurrentDocument + , updateTitle ) import MetaBrush.Document ( Document(..) @@ -227,7 +228,7 @@ instance HandleAction SaveAs where Just doc -> saveAs uiElts vars True doc saveAs :: UIElements -> Variables -> Bool -> Document -> IO () -saveAs ( UIElements { window, fileBar } ) vars@( Variables { openDocumentsTVar } ) keepOpen doc = do +saveAs ( UIElements { .. } ) vars@( Variables { openDocumentsTVar } ) keepOpen doc = do fileChooser <- GTK.fileChooserNativeNew ( Just "Save MetaBrush document..." ) ( Just window ) GTK.FileChooserActionSave @@ -258,7 +259,7 @@ saveAs ( UIElements { window, fileBar } ) vars@( Variables { openDocumentsTVar } ( Map.insert ( documentUnique doc ) ( doc { mbFilePath = Just fullFilePath, unsavedChanges = False } ) ) - else removeFileTab fileBar vars ( documentUnique doc ) + else removeFileTab window title viewportDrawingArea infoBar vars ( documentUnique doc ) ----------- -- Close -- @@ -266,14 +267,9 @@ saveAs ( UIElements { window, fileBar } ) vars@( Variables { openDocumentsTVar } data Close = CloseActive -- ^ Close active document. - | CloseThis -- ^ Close a specific tab (action to destroy tab is directly given). - { docToClose :: Unique - , destroyTabAction :: IO () - } - -instance Show Close where - show CloseActive = "CloseActive" - show ( CloseThis docToClose _ ) = "CloseThis " <> show docToClose + | CloseThis -- ^ Close a specific tab. + { docToClose :: Unique } + deriving stock Show pattern JustClose, SaveAndClose, CancelClose :: Int32 pattern JustClose = 1 @@ -281,38 +277,58 @@ pattern SaveAndClose = 2 pattern CancelClose = 3 instance HandleAction Close where - handleAction uiElts@( UIElements { window, fileBar } ) vars@( Variables { .. } ) close = do + handleAction uiElts@( UIElements { .. } ) vars@( Variables { .. } ) close = do mbDoc <- case close of - CloseActive -> STM.atomically $ currentDocument vars - CloseThis unique _ -> Map.lookup unique <$> STM.readTVarIO openDocumentsTVar + CloseActive -> STM.atomically ( currentDocument vars ) + CloseThis unique -> Map.lookup unique <$> STM.readTVarIO openDocumentsTVar case mbDoc of - Nothing -> pure () -- could show a warning message - Just doc@( Document { displayName, documentUnique } ) -> do - dialog <- GTK.new GTK.MessageDialog [] - GTK.setMessageDialogText dialog ( " \n\"" <> displayName <> "\" contains unsaved changes.\nClose anyway?" ) - GTK.setMessageDialogMessageType dialog GTK.MessageTypeQuestion - GTK.setWindowResizable dialog False - GTK.setWindowDecorated dialog False - GTK.widgetAddEvents dialog - [ GDK.EventMaskKeyPressMask, GDK.EventMaskKeyReleaseMask ] - GTK.windowSetTransientFor dialog ( Just window ) - GTK.windowSetModal dialog True - widgetAddClasses dialog [ "bg", "plain", "text", "dialog" ] - closeButton <- GTK.dialogAddButton dialog "Close" JustClose - saveButton <- GTK.dialogAddButton dialog "Save and close" SaveAndClose - cancelButton <- GTK.dialogAddButton dialog "Cancel" CancelClose - GTK.dialogSetDefaultResponse dialog 1 - for_ [ closeButton, saveButton, cancelButton ] \ button -> widgetAddClass button "dialogButton" - choice <- GTK.dialogRun dialog - GTK.widgetDestroy dialog - case choice of - JustClose -> case close of - CloseActive -> removeFileTab fileBar vars documentUnique - CloseThis _ destroyTab -> do - destroyTab - STM.atomically $ STM.modifyTVar' openDocumentsTVar ( Map.delete documentUnique ) - SaveAndClose -> saveAs uiElts vars False doc - _ -> pure () + Nothing -> pure () -- could show a warning message + Just doc@( Document { displayName, documentUnique, unsavedChanges } ) + | unsavedChanges + -> do + dialog <- GTK.new GTK.MessageDialog [] + GTK.setMessageDialogText dialog ( " \n\"" <> displayName <> "\" contains unsaved changes.\nClose anyway?" ) + GTK.setMessageDialogMessageType dialog GTK.MessageTypeQuestion + GTK.setWindowResizable dialog False + GTK.setWindowDecorated dialog False + GTK.windowSetTransientFor dialog ( Just window ) + GTK.windowSetModal dialog True + widgetAddClasses dialog [ "bg", "plain", "text", "dialog" ] + closeButton <- GTK.dialogAddButton dialog "Close" JustClose + saveButton <- GTK.dialogAddButton dialog "Save and close" SaveAndClose + cancelButton <- GTK.dialogAddButton dialog "Cancel" CancelClose + GTK.dialogSetDefaultResponse dialog 1 + for_ [ closeButton, saveButton, cancelButton ] \ button -> widgetAddClass button "dialogButton" + choice <- GTK.dialogRun dialog + GTK.widgetDestroy dialog + case choice of + JustClose -> removeFileTab window title viewportDrawingArea infoBar vars documentUnique + SaveAndClose -> saveAs uiElts vars False doc + _ -> pure () + | otherwise + -> removeFileTab window title viewportDrawingArea infoBar vars documentUnique + +--------------------- +-- Switch document -- +--------------------- + +data SwitchTo = SwitchTo Unique + deriving stock Show + +instance HandleAction SwitchTo where + handleAction ( UIElements { .. } ) vars@( Variables { .. } ) ( SwitchTo newUnique ) = do + mbNewDocAndTab <- STM.atomically do + STM.writeTVar activeDocumentTVar ( Just newUnique ) + newDoc <- Map.lookup newUnique <$> STM.readTVar openDocumentsTVar + newTab <- Map.lookup newUnique <$> STM.readTVar fileBarTabsTVar + pure ( (,) <$> newDoc <*> newTab ) + case mbNewDocAndTab of + Nothing -> updateTitle window title Nothing + Just ( Document { .. }, tab ) -> do + updateTitle window title ( Just ( displayName, unsavedChanges ) ) + updateInfoBar viewportDrawingArea infoBar vars + GTK.widgetQueueDraw tab + GTK.widgetQueueDraw viewportDrawingArea -------------- -- Quitting -- @@ -402,7 +418,7 @@ data Delete = Delete instance HandleAction Delete where handleAction - ( UIElements { viewportDrawingArea } ) + uiElts vars@( Variables { toolTVar, modeTVar } ) _ = do @@ -410,9 +426,7 @@ instance HandleAction Delete where mode <- STM.readTVarIO modeTVar case tool of -- Delete selected points on pressing 'Delete'. - Selection -> do - STM.atomically $ modifyingCurrentDocument vars ( pure . Just . deleteSelected mode ) - GTK.widgetQueueDraw viewportDrawingArea + Selection -> modifyingCurrentDocument uiElts vars ( pure . Just . deleteSelected mode ) _ -> pure () ------------ @@ -497,7 +511,7 @@ data MouseClick = MouseClick Word32 ( Point2D Double ) instance HandleAction MouseClick where handleAction - ( UIElements { viewportDrawingArea } ) + uiElts@( UIElements { viewportDrawingArea } ) vars@( Variables { .. } ) ( MouseClick button mouseClickCoords ) = case button of @@ -506,7 +520,7 @@ instance HandleAction MouseClick where 1 -> do viewportWidth <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth viewportDrawingArea viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea - STM.atomically $ modifyingCurrentDocument vars \ doc@( Document { zoomFactor, viewportCenter } ) -> do + modifyingCurrentDocument uiElts vars \ doc@( Document { zoomFactor, viewportCenter } ) -> do let toViewport :: Point2D Double -> Point2D Double toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter @@ -557,7 +571,6 @@ instance HandleAction MouseClick where Just pp -> do STM.writeTVar partialPathTVar ( Just $ pp { firstPoint = False } ) pure Nothing - GTK.widgetQueueDraw viewportDrawingArea -- Right mouse button: end partial path. 3 -> do @@ -577,7 +590,7 @@ data MouseRelease = MouseRelease Word32 ( Point2D Double ) instance HandleAction MouseRelease where handleAction - ( UIElements { viewportDrawingArea } ) + uiElts@( UIElements { viewportDrawingArea } ) vars@( Variables { .. } ) ( MouseRelease button ( Point2D x y ) ) = case button of @@ -586,7 +599,7 @@ instance HandleAction MouseRelease where 1 -> do viewportWidth <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth viewportDrawingArea viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea - STM.atomically $ modifyingCurrentDocument vars \ doc@( Document { zoomFactor, viewportCenter } ) -> do + modifyingCurrentDocument uiElts vars \ doc@( Document { zoomFactor, viewportCenter } ) -> do let toViewport :: Point2D Double -> Point2D Double toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter @@ -691,8 +704,6 @@ instance HandleAction MouseRelease where ] pure ( Just $ addToAnchor anchor newSegment doc ) - GTK.widgetQueueDraw viewportDrawingArea - -- Other mouse buttons: ignored (for the moment at least). _ -> pure () @@ -704,13 +715,13 @@ data Scroll = Scroll ( Point2D Double ) ( Vector2D Double ) deriving stock Show instance HandleAction Scroll where - handleAction ( UIElements { .. } ) vars@( Variables { .. } ) ( Scroll ( Point2D x y ) ( Vector2D dx dy ) ) = do + handleAction uiElts@( UIElements { .. } ) vars@( Variables { .. } ) ( Scroll ( Point2D x y ) ( Vector2D dx dy ) ) = do viewportWidth <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth viewportDrawingArea viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea unless ( dx == 0 && dy == 0 ) do - STM.atomically $ modifyingCurrentDocument vars \ ( doc@( Document { viewportCenter = oldCenter, zoomFactor = oldZoomFactor } ) ) -> do + modifyingCurrentDocument uiElts vars \ ( doc@( Document { viewportCenter = oldCenter, zoomFactor = oldZoomFactor } ) ) -> do modifiers <- STM.readTVar modifiersTVar let toViewport :: Point2D Double -> Point2D Double @@ -757,7 +768,6 @@ instance HandleAction Scroll where STM.writeTVar mousePosTVar ( Just finalMousePos ) pure ( Just newDoc ) updateInfoBar viewportDrawingArea infoBar vars - GTK.widgetQueueDraw viewportDrawingArea -------------------- -- Keyboard press -- diff --git a/src/app/MetaBrush/Context.hs b/src/app/MetaBrush/Context.hs index bd938ee..1e26c4e 100644 --- a/src/app/MetaBrush/Context.hs +++ b/src/app/MetaBrush/Context.hs @@ -1,5 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} module MetaBrush.Context @@ -7,12 +9,17 @@ module MetaBrush.Context , LR(..), Modifier(..), modifierKey, modifierType , HoldAction(..), PartialPath(..) , currentDocument, withCurrentDocument, modifyingCurrentDocument + , updateTitle ) where -- base +import Control.Monad + ( join ) import Data.Foldable - ( for_ ) + ( for_, sequenceA_ ) +import Data.Traversable + ( for ) import Data.Word ( Word32 ) @@ -33,14 +40,20 @@ import qualified GI.Gtk as GTK -- stm import Control.Concurrent.STM ( STM ) +import qualified Control.Concurrent.STM as STM + ( atomically ) import qualified Control.Concurrent.STM.TVar as STM ( TVar, readTVar, readTVar, writeTVar ) +-- text +import Data.Text + ( Text ) + -- MetaBrush import Math.Vector2D ( Point2D ) import MetaBrush.Document - ( Document ) + ( Document(..) ) import MetaBrush.Document.Draw ( DrawAnchor ) import {-# SOURCE #-} MetaBrush.UI.FileBar @@ -77,6 +90,7 @@ data Variables , toolTVar :: !( STM.TVar Tool ) , modeTVar :: !( STM.TVar Mode ) , partialPathTVar :: !( STM.TVar ( Maybe PartialPath ) ) + , fileBarTabsTVar :: !( STM.TVar ( Map Unique GTK.Box ) ) } -------------------------------------------------------------------------------- @@ -142,14 +156,34 @@ withCurrentDocument vars f = traverse f =<< currentDocument vars -- | Modify the currently active document. -- -- Does nothing if no document is currently active. -modifyingCurrentDocument :: Variables -> ( Document -> STM ( Maybe Document ) ) -> STM () -modifyingCurrentDocument ( Variables { activeDocumentTVar, openDocumentsTVar } ) f = do - mbUnique <- STM.readTVar activeDocumentTVar - case mbUnique of - Nothing -> pure () - Just unique -> do +modifyingCurrentDocument :: UIElements -> Variables -> ( Document -> STM ( Maybe Document ) ) -> IO () +modifyingCurrentDocument ( UIElements { .. } ) ( Variables { .. } ) f = do + mbActions <- STM.atomically do + mbUnique <- STM.readTVar activeDocumentTVar + for mbUnique \ unique -> do docs <- STM.readTVar openDocumentsTVar - for_ ( Map.lookup unique docs ) \ oldDoc -> do - mbNewDoc <- f oldDoc - for_ mbNewDoc \ newDoc -> do - STM.writeTVar openDocumentsTVar ( Map.insert unique newDoc docs ) + mbUpdateTitleAction <- + join <$> for ( Map.lookup unique docs ) \ oldDoc -> do + mbNewDoc <- f oldDoc + for mbNewDoc \ newDoc -> do + STM.writeTVar openDocumentsTVar ( Map.insert unique newDoc docs ) + pure do + updateTitle window title $ Just ( displayName newDoc, unsavedChanges newDoc ) + GTK.widgetQueueDraw viewportDrawingArea + mbActiveTab <- Map.lookup unique <$> STM.readTVar fileBarTabsTVar + pure ( for_ mbActiveTab GTK.widgetQueueDraw *> sequenceA_ mbUpdateTitleAction ) + sequenceA_ mbActions + +updateTitle :: GTK.Window -> GTK.Label -> Maybe ( Text, Bool ) -> IO () +updateTitle window title mbTitleText = do + GTK.labelSetText title titleText + GTK.setWindowTitle window titleText + where + titleText :: Text + titleText = case mbTitleText of + Nothing -> "MetaBrush" + Just ( name, hasUnsavedChanges ) + | hasUnsavedChanges + -> "● " <> name <> " – MetaBrush" + | otherwise + -> name <> " – MetaBrush" diff --git a/src/app/MetaBrush/UI/FileBar.hs b/src/app/MetaBrush/UI/FileBar.hs index d82b268..afd01f5 100644 --- a/src/app/MetaBrush/UI/FileBar.hs +++ b/src/app/MetaBrush/UI/FileBar.hs @@ -14,25 +14,16 @@ module MetaBrush.UI.FileBar -- base import Control.Monad - ( unless, void, when ) -import Data.Maybe - ( listToMaybe ) + ( join, void ) import Data.Foldable - ( for_ ) -import qualified Foreign.Marshal.Alloc as Foreign - ( malloc, free ) -import qualified Foreign.Ptr as Foreign - ( castPtr, nullPtr ) -import qualified Foreign.Storable as Foreign - ( peek, poke ) + ( for_, sequenceA_ ) +import Data.Traversable + ( for ) -- containers import qualified Data.Map.Strict as Map ( lookup, insert, delete ) --- gi-gobject -import qualified GI.GObject as GObject - -- gi-gtk import qualified GI.Gtk as GTK @@ -40,17 +31,15 @@ import qualified GI.Gtk as GTK import qualified Control.Concurrent.STM as STM ( atomically ) import qualified Control.Concurrent.STM.TVar as STM - ( writeTVar, readTVarIO, modifyTVar' ) - --- text -import Data.Text - ( Text ) + ( writeTVar, readTVar, readTVarIO, modifyTVar' ) -- MetaBrush import MetaBrush.Action - ( Close(..), handleAction ) + ( SwitchTo(..), Close(..), handleAction ) import MetaBrush.Context - ( UIElements(..), Variables(..) ) + ( UIElements(..), Variables(..) + , updateTitle + ) import MetaBrush.Document ( Document(..), emptyDocument ) import {-# SOURCE #-} MetaBrush.UI.InfoBar @@ -59,7 +48,7 @@ import MetaBrush.Unique ( Unique, freshUnique, uniqueText ) import MetaBrush.Util ( widgetAddClass, widgetAddClasses - , (>>?=), Exists(..) + , Exists(..) ) -------------------------------------------------------------------------------- @@ -83,7 +72,7 @@ newFileTab -> TabLocation -> IO () newFileTab - vars@( Variables { uniqueSupply, activeDocumentTVar, openDocumentsTVar } ) + vars@( Variables { .. } ) uiElts@( UIElements { fileBar = FileBar {..}, .. } ) mbDoc newTabLoc @@ -113,35 +102,22 @@ newFileTab widgetAddClasses closeFileButton [ "fileBarCloseButton" ] GTK.widgetShowAll tab - -- Associate each tab with the corresponding document unique, - -- so we can know which document corresponds to each file tab - -- by only looking at the tab. - let - newUnique :: Unique - newUnique = documentUnique newDoc - uniquePtr <- Foreign.malloc @Unique - Foreign.poke uniquePtr newUnique - GObject.objectSetData tab "unique" ( Foreign.castPtr @Unique @() uniquePtr ) - -- We've placed the new tab at the end. Now rearrange it if needed. case newTabLoc of LastTab -> pure () AfterCurrentTab -> do - children <- GTK.containerGetChildren fileTabsBox - for_ ( zip children [0..] ) \ ( childWidget, activeTabIndex ) -> do - mbBox <- GTK.castTo GTK.Box childWidget - for_ mbBox \ box -> do - mbButton - <- ( listToMaybe <$> GTK.containerGetChildren box ) - >>?= GTK.castTo GTK.RadioButton - for_ mbButton \ button -> do - isActive <- GTK.toggleButtonGetActive button - if isActive - then - GTK.boxReorderChild fileTabsBox tab ( activeTabIndex + 1 ) - else - pure () - + mbActiveTab <- fmap join $ STM.atomically do + mbUnique <- STM.readTVar activeDocumentTVar + for mbUnique \ docUnique -> do + Map.lookup docUnique <$> STM.readTVar fileBarTabsTVar + for_ mbActiveTab \ activeTab -> do + children <- GTK.containerGetChildren fileTabsBox + for_ ( zip children [0..] ) \ ( childWidget, activeTabIndex ) -> do + mbBox <- GTK.castTo GTK.Box childWidget + for_ mbBox \ box -> + 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. for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do @@ -155,10 +131,14 @@ newFileTab pure False -- Update the state: switch to this new document. - + let + newUnique :: Unique + newUnique = documentUnique newDoc STM.atomically do - STM.modifyTVar' openDocumentsTVar ( Map.insert newUnique newDoc ) - STM.writeTVar activeDocumentTVar ( Just newUnique ) + STM.modifyTVar' openDocumentsTVar ( Map.insert newUnique newDoc ) + STM.modifyTVar' fileBarTabsTVar ( Map.insert newUnique tab ) + STM.writeTVar activeDocumentTVar ( Just newUnique ) + GTK.widgetQueueDraw viewportDrawingArea void $ GTK.onButtonClicked pgButton do @@ -167,24 +147,8 @@ newFileTab if isActive then do GTK.widgetSetStateFlags tab ( GTK.StateFlagsActive : flags ) True - STM.atomically ( STM.writeTVar activeDocumentTVar ( Just newUnique ) ) - mbActiveDoc <- Map.lookup newUnique <$> STM.readTVarIO openDocumentsTVar - case mbActiveDoc of - Nothing -> do - GTK.labelSetText title "MetaBrush" - GTK.setWindowTitle window "MetaBrush" - Just ( Document { .. } ) -> do - let - titleText :: Text - titleText - | unsavedChanges - = "● " <> displayName <> " – MetaBrush" - | otherwise - = displayName <> " – MetaBrush" - GTK.labelSetText title titleText - GTK.setWindowTitle window titleText - updateInfoBar viewportDrawingArea infoBar vars - GTK.widgetQueueDraw viewportDrawingArea + handleAction uiElts vars + ( SwitchTo newUnique ) else do GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsActive ) flags ) True GTK.labelSetText title "MetaBrush" @@ -192,7 +156,7 @@ newFileTab void $ GTK.onButtonClicked closeFileButton ( handleAction uiElts vars - ( CloseThis newUnique ( Foreign.free uniquePtr *> GTK.widgetDestroy tab ) ) + ( CloseThis newUnique ) ) GTK.toggleButtonSetActive pgButton True @@ -254,15 +218,29 @@ createFileBar pure fileBar -- | Close a document: remove the corresponding file tab from the file bar. -removeFileTab :: FileBar -> Variables -> Unique -> IO () -removeFileTab ( FileBar { fileTabsBox } ) ( Variables { openDocumentsTVar } ) docUnique = do - GTK.containerForeach fileTabsBox \ tab -> do +removeFileTab :: GTK.Window -> GTK.Label -> GTK.DrawingArea -> InfoBar -> Variables -> Unique -> IO () +removeFileTab window title viewportDrawingArea infoBar vars@( Variables { .. } ) docUnique = do - uniquePtr <- Foreign.castPtr @() @Unique <$> GObject.objectGetData tab "unique" - unless ( uniquePtr == Foreign.nullPtr ) do - tabUnique <- Foreign.peek uniquePtr - when ( docUnique == tabUnique ) do - Foreign.free uniquePtr - GTK.widgetDestroy tab + cleanupActions <- STM.atomically do + -- Remove the tab. + mbTab <- Map.lookup docUnique <$> STM.readTVar fileBarTabsTVar + mbAction1 <- for mbTab \ tab -> do + STM.modifyTVar' openDocumentsTVar ( Map.delete docUnique ) + STM.modifyTVar' fileBarTabsTVar ( Map.delete docUnique ) + pure ( GTK.widgetDestroy tab ) + + -- Update title and drawing area if we closed the active document. + mbActiveUnique <- STM.readTVar activeDocumentTVar + mbAction2 <- for mbActiveUnique \ activeUnique -> + if activeUnique == docUnique + then do + STM.writeTVar activeDocumentTVar Nothing + pure do + updateTitle window title Nothing + GTK.widgetQueueDraw viewportDrawingArea + updateInfoBar viewportDrawingArea infoBar vars + else pure ( pure () ) - STM.atomically $ STM.modifyTVar' openDocumentsTVar ( Map.delete docUnique ) + + pure ( sequenceA_ mbAction1 *> sequenceA_ mbAction2 ) + cleanupActions diff --git a/src/app/MetaBrush/UI/FileBar.hs-boot b/src/app/MetaBrush/UI/FileBar.hs-boot index 419a193..0f25e27 100644 --- a/src/app/MetaBrush/UI/FileBar.hs-boot +++ b/src/app/MetaBrush/UI/FileBar.hs-boot @@ -40,4 +40,4 @@ createFileBar newFileTab :: Variables -> UIElements -> Maybe Document -> TabLocation -> IO () -removeFileTab :: FileBar -> Variables -> Unique -> IO () +removeFileTab :: GTK.Window -> GTK.Label -> GTK.DrawingArea -> InfoBar -> Variables -> Unique -> IO ()