mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
allow document titles to be edited
This commit is contained in:
parent
71f42894f8
commit
6ecfebd397
|
@ -466,11 +466,20 @@ To specify it in CSS, set the box-shadow of the contents node."
|
||||||
border-color: @active;
|
border-color: @active;
|
||||||
}
|
}
|
||||||
|
|
||||||
.metabrush .fileBarTab:active, .metabrush .fileBarTab:checked {
|
.metabrush .activeTab {
|
||||||
border-color: @base;
|
border-color: @base;
|
||||||
background-color: @active;
|
background-color: @active;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
.metabrush .activeTab:hover {
|
||||||
|
border-color: @base;
|
||||||
|
}
|
||||||
|
|
||||||
|
.metabrush .fileBarTab label {
|
||||||
|
margin-left: 4px;
|
||||||
|
color: @plain;
|
||||||
|
}
|
||||||
|
|
||||||
.metabrush .fileBarTabButton {
|
.metabrush .fileBarTabButton {
|
||||||
padding-left: 8px;
|
padding-left: 8px;
|
||||||
padding-right: 2px;
|
padding-right: 2px;
|
||||||
|
|
|
@ -499,44 +499,44 @@ instance HandleAction Close where
|
||||||
-- Switch document --
|
-- Switch document --
|
||||||
---------------------
|
---------------------
|
||||||
|
|
||||||
data SwitchFromTo =
|
data SwitchTo =
|
||||||
SwitchFromTo
|
SwitchTo
|
||||||
{ mbPrevActiveDocUnique :: !( Maybe Unique )
|
{ newActiveDocUnique :: !Unique
|
||||||
, newActiveDocUnique :: !Unique
|
|
||||||
}
|
}
|
||||||
deriving stock Show
|
deriving stock Show
|
||||||
|
|
||||||
instance HandleAction SwitchFromTo where
|
instance HandleAction SwitchTo where
|
||||||
handleAction
|
handleAction
|
||||||
uiElts
|
uiElts
|
||||||
vars@( Variables {..} )
|
vars@( Variables {..} )
|
||||||
( SwitchFromTo { mbPrevActiveDocUnique, newActiveDocUnique } )
|
( SwitchTo { newActiveDocUnique } ) = do
|
||||||
| mbPrevActiveDocUnique == Just newActiveDocUnique
|
uiAction <- STM.atomically $ do
|
||||||
= do
|
mbPrevActiveDocUnique <- STM.swapTVar activeDocumentTVar ( Just newActiveDocUnique )
|
||||||
mbActiveTab <- Map.lookup newActiveDocUnique <$> STM.readTVarIO fileBarTabsTVar
|
if mbPrevActiveDocUnique == Just newActiveDocUnique
|
||||||
for_ mbActiveTab \ ( FileBarTab { fileBarTab = activeTab, fileBarTabButton = activeTabButton } ) -> do
|
then
|
||||||
GTK.toggleButtonSetActive activeTabButton True
|
return $ return ()
|
||||||
flags <- GTK.widgetGetStateFlags activeTab
|
else do
|
||||||
GTK.widgetSetStateFlags activeTab
|
|
||||||
( GTK.StateFlagsActive : filter (/= GTK.StateFlagsActive) flags )
|
|
||||||
True
|
|
||||||
| otherwise
|
|
||||||
= do
|
|
||||||
uiUpdateAction <- STM.atomically do
|
|
||||||
STM.writeTVar activeDocumentTVar ( Just newActiveDocUnique )
|
|
||||||
mbHist <- Map.lookup newActiveDocUnique <$> STM.readTVar openDocumentsTVar
|
|
||||||
let change = ActiveDocChange { mbOldDocUnique = mbPrevActiveDocUnique }
|
let change = ActiveDocChange { mbOldDocUnique = mbPrevActiveDocUnique }
|
||||||
|
mbHist <- Map.lookup newActiveDocUnique <$> STM.readTVar openDocumentsTVar
|
||||||
|
mbActiveTab <- Map.lookup newActiveDocUnique <$> STM.readTVar fileBarTabsTVar
|
||||||
|
mbPrevActiveTab <-
|
||||||
|
case mbPrevActiveDocUnique of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just prevActiveDocUnique ->
|
||||||
|
Map.lookup prevActiveDocUnique <$> STM.readTVar fileBarTabsTVar
|
||||||
uiUpdateAction <- updateUIAction change uiElts vars
|
uiUpdateAction <- updateUIAction change uiElts vars
|
||||||
pure do
|
return $ do
|
||||||
|
for_ mbActiveTab $ \ ( FileBarTab { fileBarTab = activeTab } ) -> do
|
||||||
|
GTK.widgetAddCssClass activeTab "activeTab"
|
||||||
|
|
||||||
|
GTK.widgetQueueDraw activeTab
|
||||||
|
|
||||||
|
for_ mbPrevActiveTab \ ( FileBarTab { fileBarTab = prevActiveTab } ) -> do
|
||||||
|
GTK.widgetRemoveCssClass prevActiveTab "activeTab"
|
||||||
|
GTK.widgetQueueDraw prevActiveTab
|
||||||
uiUpdateAction
|
uiUpdateAction
|
||||||
for_ mbPrevActiveDocUnique \ prevActiveDocUnique -> do
|
|
||||||
mbPrevActiveTab <- Map.lookup prevActiveDocUnique <$> STM.readTVarIO fileBarTabsTVar
|
|
||||||
for_ mbPrevActiveTab \ ( FileBarTab { fileBarTab = prevActiveTab, fileBarTabButton = prevActiveTabButton } ) -> do
|
|
||||||
GTK.toggleButtonSetActive prevActiveTabButton False
|
|
||||||
flags <- GTK.widgetGetStateFlags prevActiveTab
|
|
||||||
GTK.widgetSetStateFlags prevActiveTab ( filter (/= GTK.StateFlagsActive) flags ) True
|
|
||||||
updateHistoryState uiElts mbHist
|
updateHistoryState uiElts mbHist
|
||||||
uiUpdateAction
|
uiAction
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- Quitting --
|
-- Quitting --
|
||||||
|
|
|
@ -55,12 +55,11 @@ data Close
|
||||||
{ docToClose :: !Unique }
|
{ docToClose :: !Unique }
|
||||||
instance HandleAction Close
|
instance HandleAction Close
|
||||||
|
|
||||||
data SwitchFromTo =
|
data SwitchTo =
|
||||||
SwitchFromTo
|
SwitchTo
|
||||||
{ mbPrevActiveDocUnique :: !( Maybe Unique )
|
{ newActiveDocUnique :: !Unique
|
||||||
, newActiveDocUnique :: !Unique
|
|
||||||
}
|
}
|
||||||
instance HandleAction SwitchFromTo
|
instance HandleAction SwitchTo
|
||||||
|
|
||||||
data Quit = Quit
|
data Quit = Quit
|
||||||
instance HandleAction Quit
|
instance HandleAction Quit
|
||||||
|
|
|
@ -216,13 +216,12 @@ data FileBar
|
||||||
= FileBar
|
= FileBar
|
||||||
{ fileBarBox :: !GTK.Box
|
{ fileBarBox :: !GTK.Box
|
||||||
, fileTabsBox :: !GTK.Box
|
, fileTabsBox :: !GTK.Box
|
||||||
, fileBarPhantomToggleButton :: !GTK.ToggleButton
|
|
||||||
}
|
}
|
||||||
|
|
||||||
data FileBarTab
|
data FileBarTab
|
||||||
= FileBarTab
|
= FileBarTab
|
||||||
{ fileBarTab :: !GTK.Box
|
{ fileBarTab :: !GTK.Box
|
||||||
, fileBarTabButton :: !GTK.ToggleButton
|
, fileBarTabLabel :: !GTK.EditableLabel
|
||||||
, fileBarTabCloseArea :: !GTK.DrawingArea
|
, fileBarTabCloseArea :: !GTK.DrawingArea
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -226,9 +226,7 @@ updateUIAction _docChange uiElts@( UIElements { viewport = Viewport {..}, .. } )
|
||||||
_ <- GLib.idleAdd GLib.PRIORITY_DEFAULT_IDLE $ do
|
_ <- GLib.idleAdd GLib.PRIORITY_DEFAULT_IDLE $ do
|
||||||
switchStrokeView strokesListView vars ( fst <$> mbDoc )
|
switchStrokeView strokesListView vars ( fst <$> mbDoc )
|
||||||
return False
|
return False
|
||||||
for_ mbActiveTabDoc \ ( FileBarTab { fileBarTab, fileBarTabButton, fileBarTabCloseArea }, ( _, activeDoc ) ) -> do
|
for_ mbActiveTabDoc \ ( FileBarTab { fileBarTabCloseArea }, ( _, _activeDoc ) ) -> do
|
||||||
GTK.buttonSetLabel fileBarTabButton ( documentName $ documentMetadata activeDoc )
|
|
||||||
GTK.widgetQueueDraw fileBarTab
|
|
||||||
GTK.widgetQueueDraw fileBarTabCloseArea
|
GTK.widgetQueueDraw fileBarTabCloseArea
|
||||||
updateHistoryState uiElts ( fmap snd mbDocHist )
|
updateHistoryState uiElts ( fmap snd mbDocHist )
|
||||||
STM.atomically ( STM.writeTVar redrawStrokesTVar True )
|
STM.atomically ( STM.writeTVar redrawStrokesTVar True )
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module MetaBrush.GTK.Util
|
module MetaBrush.GTK.Util
|
||||||
|
@ -7,12 +8,13 @@ module MetaBrush.GTK.Util
|
||||||
, widgetAddClasses, widgetAddClass
|
, widgetAddClasses, widgetAddClass
|
||||||
, widgetShow
|
, widgetShow
|
||||||
, (>=?=>), (>>?=)
|
, (>=?=>), (>>?=)
|
||||||
|
, editableLabelNew
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
-- base
|
-- base
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
( (>=>) )
|
( (>=>), unless )
|
||||||
import Data.Coerce
|
import Data.Coerce
|
||||||
( coerce )
|
( coerce )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
|
@ -20,6 +22,9 @@ import Data.Foldable
|
||||||
import GHC.Stack
|
import GHC.Stack
|
||||||
( HasCallStack )
|
( HasCallStack )
|
||||||
|
|
||||||
|
-- gi-gio
|
||||||
|
import qualified GI.Gio as GIO
|
||||||
|
|
||||||
-- gi-gdk
|
-- gi-gdk
|
||||||
import qualified GI.Gdk as GDK
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
@ -94,3 +99,43 @@ infixr 1 >=?=>
|
||||||
infixl 1 >>?=
|
infixl 1 >>?=
|
||||||
(>>?=) :: forall m a b. Monad m => m ( Maybe a ) -> ( a -> m ( Maybe b ) ) -> m ( Maybe b )
|
(>>?=) :: forall m a b. Monad m => m ( Maybe a ) -> ( a -> m ( Maybe b ) ) -> m ( Maybe b )
|
||||||
(>>?=) = coerce ( (>>=) @( MaybeT m ) @a @b )
|
(>>?=) = coerce ( (>>=) @( MaybeT m ) @a @b )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Create a new editable label, but remove any 'DragSource' or 'DropTarget'
|
||||||
|
-- controllers attached to it, as we don't want the label to participate in
|
||||||
|
-- drag-and-drop operations, especially because having it participate in
|
||||||
|
-- drag-and-drop operations triggers segfaults due to a GTK bug.
|
||||||
|
editableLabelNew :: IO GTK.EditableLabel
|
||||||
|
editableLabelNew = do
|
||||||
|
label <- GTK.editableLabelNew " "
|
||||||
|
widget <- GTK.toWidget label
|
||||||
|
removeControllers widget
|
||||||
|
return label
|
||||||
|
|
||||||
|
where
|
||||||
|
removeControllers :: GTK.Widget -> IO ()
|
||||||
|
removeControllers widget = do
|
||||||
|
controllers <- GTK.widgetObserveControllers widget
|
||||||
|
nbControllers <- GIO.listModelGetNItems controllers
|
||||||
|
unless ( nbControllers == 0 ) $
|
||||||
|
for_ [ 0 .. nbControllers - 1 ] $ \ i -> do
|
||||||
|
mbController <- GIO.listModelGetItem controllers i
|
||||||
|
for_ mbController $ \ controller -> do
|
||||||
|
mbDrag <- GTK.castTo GTK.DragSource controller
|
||||||
|
mbDrop <- GTK.castTo GTK.DropTarget controller
|
||||||
|
for_ mbDrag $ GTK.widgetRemoveController widget
|
||||||
|
for_ mbDrop $ GTK.widgetRemoveController widget
|
||||||
|
mbChild <- GTK.widgetGetFirstChild widget
|
||||||
|
case mbChild of
|
||||||
|
Nothing -> return ()
|
||||||
|
Just c -> do
|
||||||
|
removeControllers c
|
||||||
|
removeControllersSiblings c
|
||||||
|
removeControllersSiblings c = do
|
||||||
|
mbNext <- GTK.widgetGetNextSibling c
|
||||||
|
case mbNext of
|
||||||
|
Nothing -> return ()
|
||||||
|
Just next -> do
|
||||||
|
removeControllers next
|
||||||
|
removeControllersSiblings next
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
{-# LANGUAGE ImplicitParams #-}
|
||||||
|
{-# LANGUAGE OverloadedLabels #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module MetaBrush.UI.FileBar
|
module MetaBrush.UI.FileBar
|
||||||
|
@ -9,7 +11,7 @@ module MetaBrush.UI.FileBar
|
||||||
|
|
||||||
-- base
|
-- base
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
( join, void )
|
( join, void, when )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
( sequenceA_ )
|
( sequenceA_ )
|
||||||
import Data.Traversable
|
import Data.Traversable
|
||||||
|
@ -18,6 +20,10 @@ import Data.Traversable
|
||||||
-- containers
|
-- containers
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
|
|
||||||
|
-- generic-lens
|
||||||
|
import Data.Generics.Product.Fields
|
||||||
|
( field' )
|
||||||
|
|
||||||
-- gi-cairo-connector
|
-- gi-cairo-connector
|
||||||
import qualified GI.Cairo.Render.Connector as Cairo
|
import qualified GI.Cairo.Render.Connector as Cairo
|
||||||
( renderWithContext )
|
( renderWithContext )
|
||||||
|
@ -28,11 +34,20 @@ import qualified GI.Gio as GIO
|
||||||
-- gi-gtk
|
-- gi-gtk
|
||||||
import qualified GI.Gtk as GTK
|
import qualified GI.Gtk as GTK
|
||||||
|
|
||||||
|
-- haskell-gi-base
|
||||||
|
import qualified Data.GI.Base as GI
|
||||||
|
|
||||||
|
-- lens
|
||||||
|
import Control.Lens
|
||||||
|
( set )
|
||||||
|
import Control.Lens.At
|
||||||
|
( ix )
|
||||||
|
|
||||||
-- stm
|
-- stm
|
||||||
import qualified Control.Concurrent.STM as STM
|
import qualified Control.Concurrent.STM as STM
|
||||||
( atomically )
|
( atomically )
|
||||||
import qualified Control.Concurrent.STM.TVar as STM
|
import qualified Control.Concurrent.STM.TVar as STM
|
||||||
( writeTVar, readTVar, readTVarIO, modifyTVar' )
|
( readTVar, readTVarIO, modifyTVar' )
|
||||||
|
|
||||||
-- transformers
|
-- transformers
|
||||||
import Control.Monad.Trans.Reader
|
import Control.Monad.Trans.Reader
|
||||||
|
@ -44,8 +59,10 @@ import Data.HashMap.Lazy
|
||||||
|
|
||||||
-- MetaBrush
|
-- MetaBrush
|
||||||
import {-# SOURCE #-} MetaBrush.Application.Action
|
import {-# SOURCE #-} MetaBrush.Application.Action
|
||||||
( SwitchFromTo(..), Close(..), handleAction )
|
( SwitchTo(..), Close(..), handleAction )
|
||||||
import MetaBrush.Application.Context
|
import MetaBrush.Application.Context
|
||||||
|
import MetaBrush.Application.UpdateDocument
|
||||||
|
( ActiveDocChange (..), updateUIAction )
|
||||||
import MetaBrush.Asset.CloseTabButton
|
import MetaBrush.Asset.CloseTabButton
|
||||||
( drawCloseTabButton )
|
( drawCloseTabButton )
|
||||||
import MetaBrush.Asset.Colours
|
import MetaBrush.Asset.Colours
|
||||||
|
@ -53,8 +70,6 @@ import MetaBrush.Asset.Colours
|
||||||
import MetaBrush.Document
|
import MetaBrush.Document
|
||||||
import MetaBrush.Document.History
|
import MetaBrush.Document.History
|
||||||
( DocumentHistory(..), newHistory )
|
( DocumentHistory(..), newHistory )
|
||||||
import MetaBrush.Application.UpdateDocument
|
|
||||||
( updateUIAction, ActiveDocChange (..) )
|
|
||||||
import MetaBrush.UI.Panels
|
import MetaBrush.UI.Panels
|
||||||
( PanelsBar )
|
( PanelsBar )
|
||||||
import MetaBrush.UI.Viewport
|
import MetaBrush.UI.Viewport
|
||||||
|
@ -88,29 +103,49 @@ newFileTab
|
||||||
newDocUniq <- STM.atomically $ runReaderT freshUnique uniqueSupply
|
newDocUniq <- STM.atomically $ runReaderT freshUnique uniqueSupply
|
||||||
pure ( newDocUniq, newHistory $ emptyDocument ( "Untitled " <> uniqueText newDocUniq ) )
|
pure ( newDocUniq, newHistory $ emptyDocument ( "Untitled " <> uniqueText newDocUniq ) )
|
||||||
|
|
||||||
-- TODO: make the file tab an EditableLabel
|
pgLabel <- GTK.editableLabelNew ( documentName $ documentMetadata $ present thisTabDocHist )
|
||||||
-- File tab elements.
|
GTK.editableSetEditable pgLabel False
|
||||||
pgButton <- GTK.toggleButtonNewWithLabel ( documentName $ documentMetadata $ present thisTabDocHist )
|
|
||||||
GTK.toggleButtonSetGroup pgButton ( Just fileBarPhantomToggleButton )
|
-- Connect a signal for editing the document name.
|
||||||
closeFileButton <- GTK.buttonNew
|
--
|
||||||
|
-- NB: we don't use the 'onEditableChanged' signal, as that updates
|
||||||
|
-- after every key stroke.
|
||||||
|
void $ GI.on pgLabel ( GI.PropertyNotify #hasFocus ) $ \ _ -> do
|
||||||
|
hasFocus <- GTK.widgetHasFocus pgLabel
|
||||||
|
when hasFocus do
|
||||||
|
newDocName <- GTK.editableGetText pgLabel
|
||||||
|
uiUpdate <-
|
||||||
|
STM.atomically $ do
|
||||||
|
STM.modifyTVar' openDocumentsTVar
|
||||||
|
( set ( ix thisTabDocUnique
|
||||||
|
. field' @"present"
|
||||||
|
. field' @"documentMetadata"
|
||||||
|
. field' @"documentName"
|
||||||
|
)
|
||||||
|
newDocName
|
||||||
|
)
|
||||||
|
updateUIAction NoActiveDocChange uiElts vars
|
||||||
|
uiUpdate
|
||||||
|
GTK.editableSetEditable pgLabel False
|
||||||
|
|
||||||
closeFileArea <- GTK.drawingAreaNew
|
closeFileArea <- GTK.drawingAreaNew
|
||||||
GTK.buttonSetChild closeFileButton ( Just closeFileArea )
|
|
||||||
|
|
||||||
GTK.drawingAreaSetDrawFunc closeFileArea $ Just \ _ cairoContext _ _ -> void do
|
GTK.drawingAreaSetDrawFunc closeFileArea $ Just \ _ cairoContext _ _ -> void do
|
||||||
mbTabDoc <- fmap present . Map.lookup thisTabDocUnique <$> STM.readTVarIO openDocumentsTVar
|
mbTabDoc <- fmap present . Map.lookup thisTabDocUnique <$> STM.readTVarIO openDocumentsTVar
|
||||||
let
|
let
|
||||||
unsaved :: Bool
|
unsaved :: Bool
|
||||||
unsaved = maybe False ( unsavedChanges . documentContent ) mbTabDoc
|
unsaved = maybe False ( unsavedChanges . documentContent ) mbTabDoc
|
||||||
flags <- GTK.widgetGetStateFlags closeFileButton
|
flags <- GTK.widgetGetStateFlags closeFileArea
|
||||||
Cairo.renderWithContext ( drawCloseTabButton colours unsaved flags ) cairoContext
|
Cairo.renderWithContext ( drawCloseTabButton colours unsaved flags ) cairoContext
|
||||||
|
|
||||||
-- Create box for file tab elements.
|
-- Create box for file tab elements.
|
||||||
tab <- GTK.boxNew GTK.OrientationHorizontal 0
|
tab <- GTK.boxNew GTK.OrientationHorizontal 0
|
||||||
widgetAddClasses tab [ "fileBarTab" ]
|
widgetAddClasses tab [ "fileBarTab" ]
|
||||||
GTK.boxAppend tab pgButton
|
GTK.boxAppend tab pgLabel
|
||||||
GTK.boxAppend tab closeFileButton
|
GTK.boxAppend tab closeFileArea
|
||||||
widgetAddClasses pgButton [ "fileBarTabButton" ]
|
widgetAddClasses closeFileArea [ "fileBarCloseButton" ]
|
||||||
widgetAddClasses closeFileButton [ "fileBarCloseButton" ]
|
|
||||||
|
pgClicks <- GTK.gestureClickNew
|
||||||
|
|
||||||
-- Place the new tab in the correct position within the file bar.
|
-- Place the new tab in the correct position within the file bar.
|
||||||
case newTabLoc of
|
case newTabLoc of
|
||||||
|
@ -131,55 +166,41 @@ newFileTab
|
||||||
fileBarTab =
|
fileBarTab =
|
||||||
FileBarTab
|
FileBarTab
|
||||||
{ fileBarTab = tab
|
{ fileBarTab = tab
|
||||||
, fileBarTabButton = pgButton
|
, fileBarTabLabel = pgLabel
|
||||||
, fileBarTabCloseArea = closeFileArea
|
, fileBarTabCloseArea = closeFileArea
|
||||||
}
|
}
|
||||||
-- Update the state: switch to this new document.
|
-- Add this document to the set of existing documents.
|
||||||
uiUpdateAction <- STM.atomically do
|
STM.atomically do
|
||||||
STM.modifyTVar' openDocumentsTVar ( Map.insert thisTabDocUnique thisTabDocHist )
|
STM.modifyTVar' openDocumentsTVar ( Map.insert thisTabDocUnique thisTabDocHist )
|
||||||
STM.modifyTVar' fileBarTabsTVar ( Map.insert thisTabDocUnique fileBarTab )
|
STM.modifyTVar' fileBarTabsTVar ( Map.insert thisTabDocUnique fileBarTab )
|
||||||
mbOldDoc <- STM.readTVar activeDocumentTVar
|
|
||||||
STM.writeTVar activeDocumentTVar ( Just thisTabDocUnique )
|
|
||||||
let change = ActiveDocChange { mbOldDocUnique = mbOldDoc }
|
|
||||||
updateUIAction change uiElts vars
|
|
||||||
uiUpdateAction
|
|
||||||
|
|
||||||
void $ GTK.afterToggleButtonToggled pgButton do
|
void $ GTK.onGestureClickReleased pgClicks $ \ nbClicks _x _y -> do
|
||||||
nowActive <- GTK.toggleButtonGetActive pgButton
|
button <- GTK.gestureSingleGetCurrentButton ?self
|
||||||
flags <- GTK.widgetGetStateFlags tab
|
case button of
|
||||||
mbPrevActiveDocUnique <- STM.readTVarIO activeDocumentTVar
|
1 -> do
|
||||||
if nowActive
|
handleAction uiElts vars ( SwitchTo thisTabDocUnique )
|
||||||
then do
|
when ( nbClicks > 1 ) do
|
||||||
-- If changing tabs, switch document.
|
GTK.editableSetEditable pgLabel True
|
||||||
-- This will untoggle the previously active tab
|
GTK.editableLabelStartEditing pgLabel
|
||||||
-- ('onToggleButtonToggled' will run this handler).
|
void $ GTK.widgetGrabFocus pgLabel
|
||||||
handleAction uiElts vars ( SwitchFromTo mbPrevActiveDocUnique thisTabDocUnique )
|
_ -> return ()
|
||||||
GTK.widgetSetStateFlags tab
|
|
||||||
( GTK.StateFlagsActive : filter (/= GTK.StateFlagsActive) flags )
|
|
||||||
True
|
|
||||||
else do
|
|
||||||
-- Otherwise, ensure the tab hasn't been toggled off on its own
|
|
||||||
-- (clicking on an already selected tab shouldn't do anything, not untoggle the tab).
|
|
||||||
mbNewActiveDocUnique <- STM.readTVarIO activeDocumentTVar
|
|
||||||
case mbNewActiveDocUnique of
|
|
||||||
-- Clicking on already selected document: don't allow the tab to be toggled off.
|
|
||||||
Just unique | unique == thisTabDocUnique
|
|
||||||
-> do
|
|
||||||
GTK.toggleButtonSetActive pgButton True
|
|
||||||
GTK.widgetSetStateFlags tab
|
|
||||||
( GTK.StateFlagsActive : filter (/= GTK.StateFlagsActive) flags )
|
|
||||||
True
|
|
||||||
-- Otherwise: leave it toggled off.
|
|
||||||
_ -> GTK.widgetSetStateFlags tab
|
|
||||||
( filter (/= GTK.StateFlagsActive) flags )
|
|
||||||
True
|
|
||||||
|
|
||||||
GTK.toggleButtonSetActive pgButton False
|
closeButtonClick <- GTK.gestureClickNew
|
||||||
GTK.toggleButtonSetActive pgButton True
|
void $ GTK.onGestureClickPressed closeButtonClick $ \ _ _ _ -> do
|
||||||
|
void $ GTK.gestureSetState ?self GTK.EventSequenceStateClaimed
|
||||||
|
void $ GTK.onGestureClickReleased closeButtonClick $ \ _ _ _ -> do
|
||||||
|
button <- GTK.gestureSingleGetCurrentButton ?self
|
||||||
|
case button of
|
||||||
|
1 -> do
|
||||||
|
GTK.widgetQueueDraw closeFileArea
|
||||||
|
handleAction uiElts vars ( CloseThis thisTabDocUnique )
|
||||||
|
_ -> return ()
|
||||||
|
void $ GTK.gestureSetState ?self GTK.EventSequenceStateClaimed
|
||||||
|
GTK.widgetAddController closeFileArea closeButtonClick
|
||||||
|
GTK.widgetAddController tab pgClicks
|
||||||
|
|
||||||
void $ GTK.onButtonClicked closeFileButton do
|
-- Switch to this tab.
|
||||||
GTK.widgetQueueDraw closeFileArea
|
handleAction uiElts vars ( SwitchTo thisTabDocUnique )
|
||||||
handleAction uiElts vars ( CloseThis thisTabDocUnique )
|
|
||||||
|
|
||||||
-- | Create a file bar: tabs allowing selection of the active document.
|
-- | Create a file bar: tabs allowing selection of the active document.
|
||||||
--
|
--
|
||||||
|
@ -219,9 +240,6 @@ createFileBar
|
||||||
GTK.scrolledWindowSetChild fileTabsScroll ( Just fileTabsBox )
|
GTK.scrolledWindowSetChild fileTabsScroll ( Just fileTabsBox )
|
||||||
widgetAddClasses fileTabsBox [ "fileBar", "plain", "text" ]
|
widgetAddClasses fileTabsBox [ "fileBar", "plain", "text" ]
|
||||||
|
|
||||||
-- Phantom toggle button for when no page is selected (e.g. no documents opened yet).
|
|
||||||
fileBarPhantomToggleButton <- GTK.toggleButtonNew
|
|
||||||
|
|
||||||
let
|
let
|
||||||
fileBar :: FileBar
|
fileBar :: FileBar
|
||||||
fileBar = FileBar {..}
|
fileBar = FileBar {..}
|
||||||
|
|
|
@ -273,21 +273,6 @@ createMenuBar uiElts@( UIElements { application, window, titleBar } ) vars colou
|
||||||
widgetAddClasses menuBar [ "headerMenu", "text", "plain" ]
|
widgetAddClasses menuBar [ "headerMenu", "text", "plain" ]
|
||||||
GTK.headerBarPackStart titleBar menuBar
|
GTK.headerBarPackStart titleBar menuBar
|
||||||
|
|
||||||
-- TODO: this is a bit of a workaround to add hover highlight to top-level menu items.
|
|
||||||
-- Activating a menu somehow sets the "hover" setting,
|
|
||||||
-- so instead we use the "selected" setting for actual hover highlighting.
|
|
||||||
-- GTK4 FIXME
|
|
||||||
--topLevelMenuItems <- GTK.containerGetChildren menuBar
|
|
||||||
--for_ topLevelMenuItems \ topLevelMenuItem -> do
|
|
||||||
-- void $ GTK.onWidgetEnterNotifyEvent topLevelMenuItem \ _ -> do
|
|
||||||
-- flags <- GTK.widgetGetStateFlags topLevelMenuItem
|
|
||||||
-- GTK.widgetSetStateFlags topLevelMenuItem ( GTK.StateFlagsSelected : flags ) True
|
|
||||||
-- pure False
|
|
||||||
-- void $ GTK.onWidgetLeaveNotifyEvent topLevelMenuItem \ _ -> do
|
|
||||||
-- flags <- GTK.widgetGetStateFlags topLevelMenuItem
|
|
||||||
-- GTK.widgetSetStateFlags topLevelMenuItem ( filter ( /= GTK.StateFlagsSelected ) flags ) True
|
|
||||||
-- pure False
|
|
||||||
|
|
||||||
windowIcons <- GTK.boxNew GTK.OrientationHorizontal 0
|
windowIcons <- GTK.boxNew GTK.OrientationHorizontal 0
|
||||||
widgetAddClasses windowIcons [ "windowIcons" ]
|
widgetAddClasses windowIcons [ "windowIcons" ]
|
||||||
GTK.headerBarPackEnd titleBar windowIcons
|
GTK.headerBarPackEnd titleBar windowIcons
|
||||||
|
|
|
@ -22,7 +22,7 @@ module MetaBrush.UI.StrokeTreeView
|
||||||
import Control.Arrow
|
import Control.Arrow
|
||||||
( second )
|
( second )
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
( unless, void )
|
( void )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
( for_ )
|
( for_ )
|
||||||
import Data.List
|
import Data.List
|
||||||
|
@ -367,43 +367,6 @@ newLayerViewWidget = do
|
||||||
|
|
||||||
return expander
|
return expander
|
||||||
|
|
||||||
-- | Create a new editable label, but remove any 'DragSource' or 'DropTarget'
|
|
||||||
-- controllers attached to it, as we don't want the label to participate in
|
|
||||||
-- drag-and-drop operations, especially because having it participate in
|
|
||||||
-- drag-and-drop operations triggers segfaults due to a GTK bug.
|
|
||||||
editableLabelNew :: IO GTK.EditableLabel
|
|
||||||
editableLabelNew = do
|
|
||||||
label <- GTK.editableLabelNew " "
|
|
||||||
widget <- GTK.toWidget label
|
|
||||||
removeControllers widget
|
|
||||||
return label
|
|
||||||
|
|
||||||
where
|
|
||||||
removeControllers widget = do
|
|
||||||
controllers <- GTK.widgetObserveControllers widget
|
|
||||||
nbControllers <- GIO.listModelGetNItems controllers
|
|
||||||
unless ( nbControllers == 0 ) $
|
|
||||||
for_ [ 0 .. nbControllers - 1 ] $ \ i -> do
|
|
||||||
mbController <- GIO.listModelGetItem controllers i
|
|
||||||
for_ mbController $ \ controller -> do
|
|
||||||
mbDrag <- GTK.castTo GTK.DragSource controller
|
|
||||||
mbDrop <- GTK.castTo GTK.DropTarget controller
|
|
||||||
for_ mbDrag $ GTK.widgetRemoveController widget
|
|
||||||
for_ mbDrop $ GTK.widgetRemoveController widget
|
|
||||||
mbChild <- GTK.widgetGetFirstChild widget
|
|
||||||
case mbChild of
|
|
||||||
Nothing -> return ()
|
|
||||||
Just c -> do
|
|
||||||
removeControllers c
|
|
||||||
removeControllersSiblings c
|
|
||||||
removeControllersSiblings c = do
|
|
||||||
mbNext <- GTK.widgetGetNextSibling c
|
|
||||||
case mbNext of
|
|
||||||
Nothing -> return ()
|
|
||||||
Just next -> do
|
|
||||||
removeControllers next
|
|
||||||
removeControllersSiblings next
|
|
||||||
|
|
||||||
-- | Get the widget hierarchy for a list item, so that we can modify
|
-- | Get the widget hierarchy for a list item, so that we can modify
|
||||||
-- the wdigets to display the appropriate content.
|
-- the wdigets to display the appropriate content.
|
||||||
getLayerViewWidget :: GTK.TreeExpander -> IO LayerViewWidget
|
getLayerViewWidget :: GTK.TreeExpander -> IO LayerViewWidget
|
||||||
|
|
Loading…
Reference in a new issue