mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
refactor document modification
* the "modifyingCurrentDocument" now handles all the followup actions necessary after modifying the current document, such as updating the title bar
This commit is contained in:
parent
264fa8dff0
commit
a098eb6471
|
@ -36,7 +36,7 @@ import Data.Act
|
|||
|
||||
-- containers
|
||||
import qualified Data.Map as Map
|
||||
( lookup, insert )
|
||||
( lookup )
|
||||
import Data.Sequence
|
||||
( Seq(..) )
|
||||
import qualified Data.Sequence as Seq
|
||||
|
@ -75,7 +75,9 @@ import MetaBrush.Context
|
|||
( UIElements(..), Variables(..)
|
||||
, Modifier(..), modifierKey
|
||||
, HoldAction(..), PartialPath(..)
|
||||
, currentDocument, withCurrentDocument, modifyingCurrentDocument
|
||||
, currentDocument, withCurrentDocument
|
||||
, PureDocModification(..), DocModification(..)
|
||||
, modifyingCurrentDocument
|
||||
, updateTitle
|
||||
)
|
||||
import MetaBrush.Document
|
||||
|
@ -195,23 +197,30 @@ data Save = Save
|
|||
deriving stock Show
|
||||
|
||||
instance HandleAction Save where
|
||||
handleAction uiElts vars@( Variables { .. } ) _ = do
|
||||
mbDoc <- STM.atomically $ currentDocument vars
|
||||
case mbDoc of
|
||||
Nothing -> pure () -- could show a warning message
|
||||
Just doc@( Document { mbFilePath, unsavedChanges } )
|
||||
| Nothing <- mbFilePath
|
||||
-> saveAs uiElts vars True doc
|
||||
| False <- unsavedChanges
|
||||
-> pure ()
|
||||
| Just filePath <- mbFilePath
|
||||
-> do
|
||||
saveDocument filePath doc
|
||||
STM.atomically $
|
||||
STM.modifyTVar' openDocumentsTVar
|
||||
( Map.insert ( documentUnique doc )
|
||||
( doc { unsavedChanges = False } )
|
||||
)
|
||||
handleAction uiElts@( UIElements { .. } ) vars@( Variables { .. } ) _ =
|
||||
save uiElts vars True
|
||||
|
||||
save :: UIElements -> Variables -> Bool -> IO ()
|
||||
save uiElts vars keepOpen = do
|
||||
mbDoc <- STM.atomically $ currentDocument vars
|
||||
for_ mbDoc \case
|
||||
doc@( Document { mbFilePath, unsavedChanges } )
|
||||
| Nothing <- mbFilePath
|
||||
-> saveAs uiElts vars keepOpen
|
||||
| False <- unsavedChanges
|
||||
-> pure ()
|
||||
| Just filePath <- mbFilePath
|
||||
-> modifyingCurrentDocument uiElts vars \ _ -> do
|
||||
let
|
||||
doc' :: Document
|
||||
doc' = doc { unsavedChanges = False }
|
||||
if keepOpen
|
||||
then
|
||||
pure $ UpdateDocToAndThen
|
||||
( Just doc' )
|
||||
( saveDocument filePath doc' )
|
||||
else
|
||||
pure $ UpdateDocToAndThen Nothing ( saveDocument filePath doc' )
|
||||
|
||||
-------------
|
||||
-- Save as --
|
||||
|
@ -221,14 +230,26 @@ data SaveAs = SaveAs
|
|||
deriving stock Show
|
||||
|
||||
instance HandleAction SaveAs where
|
||||
handleAction uiElts vars _ = do
|
||||
mbDoc <- STM.atomically $ currentDocument vars
|
||||
case mbDoc of
|
||||
Nothing -> pure () -- could show a warning message
|
||||
Just doc -> saveAs uiElts vars True doc
|
||||
handleAction uiElts vars _ = saveAs uiElts vars True
|
||||
|
||||
saveAs :: UIElements -> Variables -> Bool -> Document -> IO ()
|
||||
saveAs ( UIElements { .. } ) vars@( Variables { openDocumentsTVar } ) keepOpen doc = do
|
||||
saveAs :: UIElements -> Variables -> Bool -> IO ()
|
||||
saveAs uiElts vars keepOpen = do
|
||||
mbSavePath <- askForSavePath uiElts
|
||||
for_ mbSavePath \ savePath -> do
|
||||
modifyingCurrentDocument uiElts vars \ doc -> do
|
||||
let
|
||||
doc' :: Document
|
||||
doc' = doc { mbFilePath = Just savePath, unsavedChanges = False }
|
||||
if keepOpen
|
||||
then
|
||||
pure $ UpdateDocToAndThen
|
||||
( Just doc' )
|
||||
( saveDocument savePath doc' )
|
||||
else
|
||||
pure $ UpdateDocToAndThen Nothing ( saveDocument savePath doc' )
|
||||
|
||||
askForSavePath :: UIElements -> IO ( Maybe FilePath )
|
||||
askForSavePath ( UIElements { .. } ) = do
|
||||
fileChooser <-
|
||||
GTK.fileChooserNativeNew ( Just "Save MetaBrush document..." ) ( Just window )
|
||||
GTK.FileChooserActionSave
|
||||
|
@ -241,25 +262,14 @@ saveAs ( UIElements { .. } ) vars@( Variables { openDocumentsTVar } ) keepOpen d
|
|||
GTK.fileFilterAddPattern fileFilter "*.mb"
|
||||
GTK.fileChooserAddFilter fileChooser fileFilter
|
||||
void $ GTK.nativeDialogRun fileChooser
|
||||
mbFilePath <- listToMaybe <$> GTK.fileChooserGetFilenames fileChooser
|
||||
for_ mbFilePath \ filePath -> do
|
||||
-- set the document's new file path, and modify to indicate "no unsaved changes"
|
||||
let
|
||||
fullFilePath :: FilePath
|
||||
fullFilePath
|
||||
| ".mb" <- takeExtension filePath
|
||||
= filePath
|
||||
fmap fullFilePath . listToMaybe <$> GTK.fileChooserGetFilenames fileChooser
|
||||
where
|
||||
fullFilePath :: FilePath -> FilePath
|
||||
fullFilePath fp
|
||||
| ".mb" <- takeExtension fp
|
||||
= fp
|
||||
| otherwise
|
||||
= filePath <.> "mb"
|
||||
saveDocument fullFilePath doc
|
||||
if keepOpen
|
||||
then
|
||||
STM.atomically $
|
||||
STM.modifyTVar' openDocumentsTVar
|
||||
( Map.insert ( documentUnique doc )
|
||||
( doc { mbFilePath = Just fullFilePath, unsavedChanges = False } )
|
||||
)
|
||||
else removeFileTab window title viewportDrawingArea infoBar vars ( documentUnique doc )
|
||||
= fp <.> "mb"
|
||||
|
||||
-----------
|
||||
-- Close --
|
||||
|
@ -283,7 +293,7 @@ instance HandleAction Close where
|
|||
CloseThis unique -> Map.lookup unique <$> STM.readTVarIO openDocumentsTVar
|
||||
case mbDoc of
|
||||
Nothing -> pure () -- could show a warning message
|
||||
Just doc@( Document { displayName, documentUnique, unsavedChanges } )
|
||||
Just ( Document { displayName, documentUnique, unsavedChanges } )
|
||||
| unsavedChanges
|
||||
-> do
|
||||
dialog <- GTK.new GTK.MessageDialog []
|
||||
|
@ -302,11 +312,19 @@ instance HandleAction Close where
|
|||
choice <- GTK.dialogRun dialog
|
||||
GTK.widgetDestroy dialog
|
||||
case choice of
|
||||
JustClose -> removeFileTab window title viewportDrawingArea infoBar vars documentUnique
|
||||
SaveAndClose -> saveAs uiElts vars False doc
|
||||
JustClose -> closeDocument documentUnique
|
||||
SaveAndClose -> save uiElts vars False
|
||||
_ -> pure ()
|
||||
| otherwise
|
||||
-> removeFileTab window title viewportDrawingArea infoBar vars documentUnique
|
||||
-> closeDocument documentUnique
|
||||
|
||||
where
|
||||
closeDocument :: Unique -> IO ()
|
||||
closeDocument unique = do
|
||||
removeFileTab vars unique
|
||||
updateTitle window title Nothing
|
||||
updateInfoBar viewportDrawingArea infoBar vars
|
||||
GTK.widgetQueueDraw viewportDrawingArea
|
||||
|
||||
---------------------
|
||||
-- Switch document --
|
||||
|
@ -426,7 +444,9 @@ instance HandleAction Delete where
|
|||
mode <- STM.readTVarIO modeTVar
|
||||
case tool of
|
||||
-- Delete selected points on pressing 'Delete'.
|
||||
Selection -> modifyingCurrentDocument uiElts vars ( pure . Just . deleteSelected mode )
|
||||
Selection
|
||||
-> modifyingCurrentDocument uiElts vars \ doc ->
|
||||
pure ( UpdateDocTo $ Just ( deleteSelected mode doc ) )
|
||||
_ -> pure ()
|
||||
|
||||
------------
|
||||
|
@ -544,11 +564,11 @@ instance HandleAction MouseClick where
|
|||
| Just newDoc <- dragMoveSelect mode pos doc
|
||||
-> do
|
||||
STM.writeTVar mouseHoldTVar ( Just $ DragMoveHold pos )
|
||||
pure ( Just newDoc )
|
||||
pure ( UpdateDocTo $ Just newDoc )
|
||||
-- Rectangular selection.
|
||||
_ -> do
|
||||
STM.writeTVar mouseHoldTVar ( Just $ SelectionHold pos )
|
||||
pure Nothing
|
||||
pure Don'tModifyDoc
|
||||
|
||||
-- Pen tool: start or continue a drawing operation.
|
||||
Pen -> do
|
||||
|
@ -566,11 +586,11 @@ instance HandleAction MouseClick where
|
|||
, firstPoint = True
|
||||
}
|
||||
)
|
||||
pure ( Just newDoc )
|
||||
pure ( UpdateDocTo $ Just newDoc )
|
||||
-- Path already started: indicate that we are continuing a path.
|
||||
Just pp -> do
|
||||
STM.writeTVar partialPathTVar ( Just $ pp { firstPoint = False } )
|
||||
pure Nothing
|
||||
pure Don'tModifyDoc
|
||||
|
||||
-- Right mouse button: end partial path.
|
||||
3 -> do
|
||||
|
@ -621,18 +641,18 @@ instance HandleAction MouseRelease where
|
|||
Just hold
|
||||
| DragMoveHold pos0 <- hold
|
||||
, pos0 /= pos
|
||||
-> pure . Just $ translateSelection mode ( pos0 --> pos ) doc
|
||||
-> pure ( UpdateDocTo $ Just $ translateSelection mode ( pos0 --> pos ) doc )
|
||||
| SelectionHold pos0 <- hold
|
||||
, pos0 /= pos
|
||||
-> pure . Just $ selectRectangle mode selMode pos0 pos doc
|
||||
_ -> pure . Just $ selectAt mode selMode pos doc
|
||||
-> pure ( UpdateDocTo $ Just $ selectRectangle mode selMode pos0 pos doc )
|
||||
_ -> pure ( UpdateDocTo $ Just $ selectAt mode selMode pos doc )
|
||||
|
||||
Pen -> do
|
||||
mbPartialPath <- STM.readTVar partialPathTVar
|
||||
case mbPartialPath of
|
||||
-- Normal pen mode mouse click should have created an anchor.
|
||||
-- If no anchor exists, then just ignore the mouse release event.
|
||||
Nothing -> pure Nothing
|
||||
Nothing -> pure Don'tModifyDoc
|
||||
-- Mouse click release possibilities:
|
||||
--
|
||||
-- - click was on complementary draw stroke draw anchor to close the path,
|
||||
|
@ -676,13 +696,13 @@ instance HandleAction MouseRelease where
|
|||
pure $ ControlPoint cp ( PointData Normal Empty )
|
||||
, Just ( PathPoint otherAnchorPt ( PointData Normal Empty ) )
|
||||
]
|
||||
pure ( Just $ addToAnchor anchor newSegment doc )
|
||||
pure ( UpdateDocTo $ Just $ addToAnchor anchor newSegment doc )
|
||||
else
|
||||
if firstPoint
|
||||
-- Continue current partial path.
|
||||
then do
|
||||
STM.writeTVar partialPathTVar ( Just $ PartialPath p1 partialControlPoint anchor False )
|
||||
pure Nothing
|
||||
pure Don'tModifyDoc
|
||||
-- Finish current partial path.
|
||||
else do
|
||||
STM.writeTVar partialPathTVar ( Just $ PartialPath pathPoint partialControlPoint anchor False )
|
||||
|
@ -702,7 +722,7 @@ instance HandleAction MouseRelease where
|
|||
pure $ ControlPoint cp ( PointData Normal Empty )
|
||||
, Just ( PathPoint pathPoint ( PointData Normal Empty ) )
|
||||
]
|
||||
pure ( Just $ addToAnchor anchor newSegment doc )
|
||||
pure ( UpdateDocTo $ Just $ addToAnchor anchor newSegment doc )
|
||||
|
||||
-- Other mouse buttons: ignored (for the moment at least).
|
||||
_ -> pure ()
|
||||
|
@ -766,7 +786,7 @@ instance HandleAction Scroll where
|
|||
finalMousePos :: Point2D Double
|
||||
finalMousePos = toFinalViewport ( Point2D x y )
|
||||
STM.writeTVar mousePosTVar ( Just finalMousePos )
|
||||
pure ( Just newDoc )
|
||||
pure ( UpdateDocTo $ Just newDoc )
|
||||
updateInfoBar viewportDrawingArea infoBar vars
|
||||
|
||||
--------------------
|
||||
|
@ -779,7 +799,7 @@ data KeyboardPress = KeyboardPress Word32
|
|||
instance HandleAction KeyboardPress where
|
||||
handleAction uiElts@( UIElements { .. } ) vars@( Variables { .. } ) ( KeyboardPress keyCode ) = do
|
||||
|
||||
_modifiers <- STM.atomically do
|
||||
modifiers <- STM.atomically do
|
||||
!modifiers <- STM.readTVar modifiersTVar
|
||||
for_ ( modifierKey keyCode ) \ modifier ->
|
||||
( STM.writeTVar modifiersTVar ( Set.insert modifier modifiers ) )
|
||||
|
@ -809,6 +829,14 @@ instance HandleAction KeyboardPress where
|
|||
GTK.widgetQueueDraw viewportDrawingArea
|
||||
_ -> pure ()
|
||||
|
||||
-- todo: these should be handled by accelerator,
|
||||
-- but those are not working currently
|
||||
GDK.KEY_Delete -> handleAction uiElts vars Delete
|
||||
|
||||
GDK.KEY_s
|
||||
| any ( \case { Control _ -> True; _ -> False } ) modifiers
|
||||
-> handleAction uiElts vars Save
|
||||
|
||||
_ -> pure ()
|
||||
|
||||
----------------------
|
||||
|
|
|
@ -1,25 +1,27 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module MetaBrush.Context
|
||||
( UIElements(..), Variables(..)
|
||||
, LR(..), Modifier(..), modifierKey, modifierType
|
||||
, HoldAction(..), PartialPath(..)
|
||||
, currentDocument, withCurrentDocument, modifyingCurrentDocument
|
||||
, currentDocument, withCurrentDocument
|
||||
, PureDocModification(..), DocModification(..)
|
||||
, modifyingCurrentDocument
|
||||
, updateTitle
|
||||
)
|
||||
where
|
||||
|
||||
-- base
|
||||
import Control.Monad
|
||||
( join )
|
||||
import Data.Foldable
|
||||
( for_, sequenceA_ )
|
||||
import Data.Traversable
|
||||
( for )
|
||||
import Data.Word
|
||||
( Word32 )
|
||||
|
||||
|
@ -29,7 +31,7 @@ import Data.Set
|
|||
import Data.Map.Strict
|
||||
( Map )
|
||||
import qualified Data.Map.Strict as Map
|
||||
( insert, lookup )
|
||||
( insert, lookup, delete )
|
||||
|
||||
-- gi-gtk
|
||||
import qualified GI.Gdk as GDK
|
||||
|
@ -37,18 +39,28 @@ import qualified GI.Gdk as GDK
|
|||
-- gi-gtk
|
||||
import qualified GI.Gtk as GTK
|
||||
|
||||
-- lens
|
||||
import Control.Lens.Fold
|
||||
( Fold, forOf_, sequenceAOf_ )
|
||||
|
||||
-- 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 )
|
||||
( TVar, readTVar, readTVar, modifyTVar' )
|
||||
|
||||
-- text
|
||||
import Data.Text
|
||||
( Text )
|
||||
|
||||
-- transformers
|
||||
import Control.Monad.Trans.Class
|
||||
( lift )
|
||||
import Control.Monad.Trans.Maybe
|
||||
( MaybeT(..) )
|
||||
|
||||
-- MetaBrush
|
||||
import Math.Vector2D
|
||||
( Point2D )
|
||||
|
@ -59,9 +71,9 @@ import MetaBrush.Document
|
|||
import MetaBrush.Document.Draw
|
||||
( DrawAnchor )
|
||||
import {-# SOURCE #-} MetaBrush.UI.FileBar
|
||||
( FileBar )
|
||||
( FileBar, removeFileTab )
|
||||
import {-# SOURCE #-} MetaBrush.UI.InfoBar
|
||||
( InfoBar )
|
||||
( InfoBar, updateInfoBar )
|
||||
import MetaBrush.UI.ToolBar
|
||||
( Tool, Mode )
|
||||
import MetaBrush.Unique
|
||||
|
@ -156,26 +168,60 @@ currentDocument ( Variables { activeDocumentTVar, openDocumentsTVar } )
|
|||
withCurrentDocument :: Variables -> ( Document -> STM a ) -> STM ( Maybe a )
|
||||
withCurrentDocument vars f = traverse f =<< currentDocument vars
|
||||
|
||||
data PureDocModification
|
||||
= Don'tModifyDoc
|
||||
| UpdateDocTo ( Maybe Document )
|
||||
|
||||
data DocModification
|
||||
= Don'tModifyDocAndThen { postModifAction :: IO () }
|
||||
| UpdateDocToAndThen
|
||||
{ modifDocument :: ( Maybe Document )
|
||||
, postModifAction :: IO ()
|
||||
}
|
||||
|
||||
class DocumentModification modif where
|
||||
docFold :: Fold modif ( Maybe Document )
|
||||
actionFold :: Fold modif ( IO () )
|
||||
|
||||
instance DocumentModification PureDocModification where
|
||||
docFold _ Don'tModifyDoc = pure Don'tModifyDoc
|
||||
docFold f ( UpdateDocTo mbDoc ) = UpdateDocTo <$> ( f mbDoc )
|
||||
actionFold _ a = pure a
|
||||
|
||||
instance DocumentModification DocModification where
|
||||
docFold _ don't@( Don'tModifyDocAndThen {} ) = pure don't
|
||||
docFold f ( UpdateDocToAndThen mbDoc action ) = ( \ mbDoc' -> UpdateDocToAndThen mbDoc' action ) <$> f mbDoc
|
||||
actionFold f modif = ( \ action' -> modif { postModifAction = action' } ) <$> f ( postModifAction modif )
|
||||
|
||||
-- | Modify the currently active document.
|
||||
--
|
||||
-- Does nothing if no document is currently active.
|
||||
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
|
||||
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
|
||||
modifyingCurrentDocument :: DocumentModification modif => UIElements -> Variables -> ( Document -> STM modif ) -> IO ()
|
||||
modifyingCurrentDocument ( UIElements { .. } ) vars@( Variables { .. } ) f = do
|
||||
mbAction <- STM.atomically . runMaybeT $ do
|
||||
unique <- MaybeT ( STM.readTVar activeDocumentTVar )
|
||||
oldDoc <- MaybeT ( Map.lookup unique <$> STM.readTVar openDocumentsTVar )
|
||||
modif <- lift ( f oldDoc )
|
||||
forOf_ docFold modif \case
|
||||
Nothing
|
||||
-> lift ( STM.modifyTVar' openDocumentsTVar ( Map.delete unique ) )
|
||||
Just newDoc
|
||||
-> lift ( STM.modifyTVar' openDocumentsTVar ( Map.insert unique newDoc ) )
|
||||
mbActiveTab <- lift ( Map.lookup unique <$> STM.readTVar fileBarTabsTVar )
|
||||
pure
|
||||
do
|
||||
forOf_ docFold modif \ mbNewDoc -> do
|
||||
case mbNewDoc of
|
||||
Nothing -> do
|
||||
removeFileTab vars ( documentUnique oldDoc )
|
||||
updateTitle window title Nothing
|
||||
updateInfoBar viewportDrawingArea infoBar vars
|
||||
Just ( Document { displayName, unsavedChanges } ) -> do
|
||||
updateTitle window title ( Just ( displayName, unsavedChanges ) )
|
||||
GTK.widgetQueueDraw viewportDrawingArea
|
||||
for_ mbActiveTab GTK.widgetQueueDraw
|
||||
sequenceAOf_ actionFold modif
|
||||
sequenceA_ mbAction
|
||||
|
||||
updateTitle :: GTK.Window -> GTK.Label -> Maybe ( Text, Bool ) -> IO ()
|
||||
updateTitle window title mbTitleText = do
|
||||
|
|
|
@ -45,13 +45,11 @@ import MetaBrush.Asset.CloseTabButton
|
|||
import MetaBrush.Asset.Colours
|
||||
( Colours )
|
||||
import MetaBrush.Context
|
||||
( UIElements(..), Variables(..)
|
||||
, updateTitle
|
||||
)
|
||||
( UIElements(..), Variables(..) )
|
||||
import MetaBrush.Document
|
||||
( Document(..), emptyDocument )
|
||||
import {-# SOURCE #-} MetaBrush.UI.InfoBar
|
||||
( InfoBar, updateInfoBar )
|
||||
( InfoBar )
|
||||
import MetaBrush.Unique
|
||||
( Unique, freshUnique, uniqueText )
|
||||
import MetaBrush.Util
|
||||
|
@ -234,29 +232,15 @@ createFileBar
|
|||
pure fileBar
|
||||
|
||||
-- | Close a document: remove the corresponding file tab from the file bar.
|
||||
removeFileTab :: GTK.Window -> GTK.Label -> GTK.DrawingArea -> InfoBar -> Variables -> Unique -> IO ()
|
||||
removeFileTab window title viewportDrawingArea infoBar vars@( Variables { .. } ) docUnique = do
|
||||
removeFileTab :: Variables -> Unique -> IO ()
|
||||
removeFileTab ( Variables { .. } ) docUnique = do
|
||||
|
||||
cleanupActions <- STM.atomically do
|
||||
cleanupAction <- STM.atomically do
|
||||
-- Remove the tab.
|
||||
mbTab <- Map.lookup docUnique <$> STM.readTVar fileBarTabsTVar
|
||||
mbAction1 <- for mbTab \ tab -> do
|
||||
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 () )
|
||||
|
||||
|
||||
pure ( sequenceA_ mbAction1 *> sequenceA_ mbAction2 )
|
||||
cleanupActions
|
||||
sequenceA_ cleanupAction
|
||||
|
|
|
@ -45,7 +45,4 @@ newFileTab
|
|||
-> Maybe Document -> TabLocation
|
||||
-> IO ()
|
||||
|
||||
removeFileTab
|
||||
:: GTK.Window -> GTK.Label -> GTK.DrawingArea -> InfoBar -> Variables
|
||||
-> Unique
|
||||
-> IO ()
|
||||
removeFileTab :: Variables -> Unique -> IO ()
|
||||
|
|
Loading…
Reference in a new issue