mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
allow document titles to be edited
This commit is contained in:
sheaf
parent
71f42894f8
commit
6ecfebd397
|
|
@ -466,11 +466,20 @@ To specify it in CSS, set the box-shadow of the contents node."
|
|||
border-color: @active;
|
||||
}
|
||||
|
||||
.metabrush .fileBarTab:active, .metabrush .fileBarTab:checked {
|
||||
.metabrush .activeTab {
|
||||
border-color: @base;
|
||||
background-color: @active;
|
||||
}
|
||||
|
||||
.metabrush .activeTab:hover {
|
||||
border-color: @base;
|
||||
}
|
||||
|
||||
.metabrush .fileBarTab label {
|
||||
margin-left: 4px;
|
||||
color: @plain;
|
||||
}
|
||||
|
||||
.metabrush .fileBarTabButton {
|
||||
padding-left: 8px;
|
||||
padding-right: 2px;
|
||||
|
|
|
|||
|
|
@ -499,44 +499,44 @@ instance HandleAction Close where
|
|||
-- Switch document --
|
||||
---------------------
|
||||
|
||||
data SwitchFromTo =
|
||||
SwitchFromTo
|
||||
{ mbPrevActiveDocUnique :: !( Maybe Unique )
|
||||
, newActiveDocUnique :: !Unique
|
||||
data SwitchTo =
|
||||
SwitchTo
|
||||
{ newActiveDocUnique :: !Unique
|
||||
}
|
||||
deriving stock Show
|
||||
|
||||
instance HandleAction SwitchFromTo where
|
||||
instance HandleAction SwitchTo where
|
||||
handleAction
|
||||
uiElts
|
||||
vars@( Variables {..} )
|
||||
( SwitchFromTo { mbPrevActiveDocUnique, newActiveDocUnique } )
|
||||
| mbPrevActiveDocUnique == Just newActiveDocUnique
|
||||
= do
|
||||
mbActiveTab <- Map.lookup newActiveDocUnique <$> STM.readTVarIO fileBarTabsTVar
|
||||
for_ mbActiveTab \ ( FileBarTab { fileBarTab = activeTab, fileBarTabButton = activeTabButton } ) -> do
|
||||
GTK.toggleButtonSetActive activeTabButton True
|
||||
flags <- GTK.widgetGetStateFlags activeTab
|
||||
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
|
||||
( SwitchTo { newActiveDocUnique } ) = do
|
||||
uiAction <- STM.atomically $ do
|
||||
mbPrevActiveDocUnique <- STM.swapTVar activeDocumentTVar ( Just newActiveDocUnique )
|
||||
if mbPrevActiveDocUnique == Just newActiveDocUnique
|
||||
then
|
||||
return $ return ()
|
||||
else do
|
||||
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
|
||||
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
|
||||
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
|
||||
uiUpdateAction
|
||||
uiAction
|
||||
|
||||
--------------
|
||||
-- Quitting --
|
||||
|
|
|
|||
|
|
@ -55,12 +55,11 @@ data Close
|
|||
{ docToClose :: !Unique }
|
||||
instance HandleAction Close
|
||||
|
||||
data SwitchFromTo =
|
||||
SwitchFromTo
|
||||
{ mbPrevActiveDocUnique :: !( Maybe Unique )
|
||||
, newActiveDocUnique :: !Unique
|
||||
data SwitchTo =
|
||||
SwitchTo
|
||||
{ newActiveDocUnique :: !Unique
|
||||
}
|
||||
instance HandleAction SwitchFromTo
|
||||
instance HandleAction SwitchTo
|
||||
|
||||
data Quit = Quit
|
||||
instance HandleAction Quit
|
||||
|
|
|
|||
|
|
@ -216,13 +216,12 @@ data FileBar
|
|||
= FileBar
|
||||
{ fileBarBox :: !GTK.Box
|
||||
, fileTabsBox :: !GTK.Box
|
||||
, fileBarPhantomToggleButton :: !GTK.ToggleButton
|
||||
}
|
||||
|
||||
data FileBarTab
|
||||
= FileBarTab
|
||||
{ fileBarTab :: !GTK.Box
|
||||
, fileBarTabButton :: !GTK.ToggleButton
|
||||
, fileBarTabLabel :: !GTK.EditableLabel
|
||||
, fileBarTabCloseArea :: !GTK.DrawingArea
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -226,9 +226,7 @@ updateUIAction _docChange uiElts@( UIElements { viewport = Viewport {..}, .. } )
|
|||
_ <- GLib.idleAdd GLib.PRIORITY_DEFAULT_IDLE $ do
|
||||
switchStrokeView strokesListView vars ( fst <$> mbDoc )
|
||||
return False
|
||||
for_ mbActiveTabDoc \ ( FileBarTab { fileBarTab, fileBarTabButton, fileBarTabCloseArea }, ( _, activeDoc ) ) -> do
|
||||
GTK.buttonSetLabel fileBarTabButton ( documentName $ documentMetadata activeDoc )
|
||||
GTK.widgetQueueDraw fileBarTab
|
||||
for_ mbActiveTabDoc \ ( FileBarTab { fileBarTabCloseArea }, ( _, _activeDoc ) ) -> do
|
||||
GTK.widgetQueueDraw fileBarTabCloseArea
|
||||
updateHistoryState uiElts ( fmap snd mbDocHist )
|
||||
STM.atomically ( STM.writeTVar redrawStrokesTVar True )
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module MetaBrush.GTK.Util
|
||||
|
|
@ -7,12 +8,13 @@ module MetaBrush.GTK.Util
|
|||
, widgetAddClasses, widgetAddClass
|
||||
, widgetShow
|
||||
, (>=?=>), (>>?=)
|
||||
, editableLabelNew
|
||||
)
|
||||
where
|
||||
|
||||
-- base
|
||||
import Control.Monad
|
||||
( (>=>) )
|
||||
( (>=>), unless )
|
||||
import Data.Coerce
|
||||
( coerce )
|
||||
import Data.Foldable
|
||||
|
|
@ -20,6 +22,9 @@ import Data.Foldable
|
|||
import GHC.Stack
|
||||
( HasCallStack )
|
||||
|
||||
-- gi-gio
|
||||
import qualified GI.Gio as GIO
|
||||
|
||||
-- gi-gdk
|
||||
import qualified GI.Gdk as GDK
|
||||
|
||||
|
|
@ -94,3 +99,43 @@ infixr 1 >=?=>
|
|||
infixl 1 >>?=
|
||||
(>>?=) :: forall m a b. Monad m => m ( Maybe a ) -> ( a -> m ( Maybe b ) ) -> m ( Maybe 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 #-}
|
||||
|
||||
module MetaBrush.UI.FileBar
|
||||
|
|
@ -9,7 +11,7 @@ module MetaBrush.UI.FileBar
|
|||
|
||||
-- base
|
||||
import Control.Monad
|
||||
( join, void )
|
||||
( join, void, when )
|
||||
import Data.Foldable
|
||||
( sequenceA_ )
|
||||
import Data.Traversable
|
||||
|
|
@ -18,6 +20,10 @@ import Data.Traversable
|
|||
-- containers
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
-- generic-lens
|
||||
import Data.Generics.Product.Fields
|
||||
( field' )
|
||||
|
||||
-- gi-cairo-connector
|
||||
import qualified GI.Cairo.Render.Connector as Cairo
|
||||
( renderWithContext )
|
||||
|
|
@ -28,11 +34,20 @@ import qualified GI.Gio as GIO
|
|||
-- gi-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
|
||||
import qualified Control.Concurrent.STM as STM
|
||||
( atomically )
|
||||
import qualified Control.Concurrent.STM.TVar as STM
|
||||
( writeTVar, readTVar, readTVarIO, modifyTVar' )
|
||||
( readTVar, readTVarIO, modifyTVar' )
|
||||
|
||||
-- transformers
|
||||
import Control.Monad.Trans.Reader
|
||||
|
|
@ -44,8 +59,10 @@ import Data.HashMap.Lazy
|
|||
|
||||
-- MetaBrush
|
||||
import {-# SOURCE #-} MetaBrush.Application.Action
|
||||
( SwitchFromTo(..), Close(..), handleAction )
|
||||
( SwitchTo(..), Close(..), handleAction )
|
||||
import MetaBrush.Application.Context
|
||||
import MetaBrush.Application.UpdateDocument
|
||||
( ActiveDocChange (..), updateUIAction )
|
||||
import MetaBrush.Asset.CloseTabButton
|
||||
( drawCloseTabButton )
|
||||
import MetaBrush.Asset.Colours
|
||||
|
|
@ -53,8 +70,6 @@ import MetaBrush.Asset.Colours
|
|||
import MetaBrush.Document
|
||||
import MetaBrush.Document.History
|
||||
( DocumentHistory(..), newHistory )
|
||||
import MetaBrush.Application.UpdateDocument
|
||||
( updateUIAction, ActiveDocChange (..) )
|
||||
import MetaBrush.UI.Panels
|
||||
( PanelsBar )
|
||||
import MetaBrush.UI.Viewport
|
||||
|
|
@ -88,29 +103,49 @@ newFileTab
|
|||
newDocUniq <- STM.atomically $ runReaderT freshUnique uniqueSupply
|
||||
pure ( newDocUniq, newHistory $ emptyDocument ( "Untitled " <> uniqueText newDocUniq ) )
|
||||
|
||||
-- TODO: make the file tab an EditableLabel
|
||||
-- File tab elements.
|
||||
pgButton <- GTK.toggleButtonNewWithLabel ( documentName $ documentMetadata $ present thisTabDocHist )
|
||||
GTK.toggleButtonSetGroup pgButton ( Just fileBarPhantomToggleButton )
|
||||
closeFileButton <- GTK.buttonNew
|
||||
pgLabel <- GTK.editableLabelNew ( documentName $ documentMetadata $ present thisTabDocHist )
|
||||
GTK.editableSetEditable pgLabel False
|
||||
|
||||
-- Connect a signal for editing the document name.
|
||||
--
|
||||
-- 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
|
||||
GTK.buttonSetChild closeFileButton ( Just closeFileArea )
|
||||
|
||||
GTK.drawingAreaSetDrawFunc closeFileArea $ Just \ _ cairoContext _ _ -> void do
|
||||
mbTabDoc <- fmap present . Map.lookup thisTabDocUnique <$> STM.readTVarIO openDocumentsTVar
|
||||
let
|
||||
unsaved :: Bool
|
||||
unsaved = maybe False ( unsavedChanges . documentContent ) mbTabDoc
|
||||
flags <- GTK.widgetGetStateFlags closeFileButton
|
||||
flags <- GTK.widgetGetStateFlags closeFileArea
|
||||
Cairo.renderWithContext ( drawCloseTabButton colours unsaved flags ) cairoContext
|
||||
|
||||
-- Create box for file tab elements.
|
||||
tab <- GTK.boxNew GTK.OrientationHorizontal 0
|
||||
widgetAddClasses tab [ "fileBarTab" ]
|
||||
GTK.boxAppend tab pgButton
|
||||
GTK.boxAppend tab closeFileButton
|
||||
widgetAddClasses pgButton [ "fileBarTabButton" ]
|
||||
widgetAddClasses closeFileButton [ "fileBarCloseButton" ]
|
||||
GTK.boxAppend tab pgLabel
|
||||
GTK.boxAppend tab closeFileArea
|
||||
widgetAddClasses closeFileArea [ "fileBarCloseButton" ]
|
||||
|
||||
pgClicks <- GTK.gestureClickNew
|
||||
|
||||
-- Place the new tab in the correct position within the file bar.
|
||||
case newTabLoc of
|
||||
|
|
@ -131,55 +166,41 @@ newFileTab
|
|||
fileBarTab =
|
||||
FileBarTab
|
||||
{ fileBarTab = tab
|
||||
, fileBarTabButton = pgButton
|
||||
, fileBarTabLabel = pgLabel
|
||||
, fileBarTabCloseArea = closeFileArea
|
||||
}
|
||||
-- Update the state: switch to this new document.
|
||||
uiUpdateAction <- STM.atomically do
|
||||
-- Add this document to the set of existing documents.
|
||||
STM.atomically do
|
||||
STM.modifyTVar' openDocumentsTVar ( Map.insert thisTabDocUnique thisTabDocHist )
|
||||
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
|
||||
nowActive <- GTK.toggleButtonGetActive pgButton
|
||||
flags <- GTK.widgetGetStateFlags tab
|
||||
mbPrevActiveDocUnique <- STM.readTVarIO activeDocumentTVar
|
||||
if nowActive
|
||||
then do
|
||||
-- If changing tabs, switch document.
|
||||
-- This will untoggle the previously active tab
|
||||
-- ('onToggleButtonToggled' will run this handler).
|
||||
handleAction uiElts vars ( SwitchFromTo mbPrevActiveDocUnique thisTabDocUnique )
|
||||
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
|
||||
void $ GTK.onGestureClickReleased pgClicks $ \ nbClicks _x _y -> do
|
||||
button <- GTK.gestureSingleGetCurrentButton ?self
|
||||
case button of
|
||||
1 -> do
|
||||
handleAction uiElts vars ( SwitchTo thisTabDocUnique )
|
||||
when ( nbClicks > 1 ) do
|
||||
GTK.editableSetEditable pgLabel True
|
||||
GTK.editableLabelStartEditing pgLabel
|
||||
void $ GTK.widgetGrabFocus pgLabel
|
||||
_ -> return ()
|
||||
|
||||
GTK.toggleButtonSetActive pgButton False
|
||||
GTK.toggleButtonSetActive pgButton True
|
||||
closeButtonClick <- GTK.gestureClickNew
|
||||
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
|
||||
GTK.widgetQueueDraw closeFileArea
|
||||
handleAction uiElts vars ( CloseThis thisTabDocUnique )
|
||||
-- Switch to this tab.
|
||||
handleAction uiElts vars ( SwitchTo thisTabDocUnique )
|
||||
|
||||
-- | Create a file bar: tabs allowing selection of the active document.
|
||||
--
|
||||
|
|
@ -219,9 +240,6 @@ createFileBar
|
|||
GTK.scrolledWindowSetChild fileTabsScroll ( Just fileTabsBox )
|
||||
widgetAddClasses fileTabsBox [ "fileBar", "plain", "text" ]
|
||||
|
||||
-- Phantom toggle button for when no page is selected (e.g. no documents opened yet).
|
||||
fileBarPhantomToggleButton <- GTK.toggleButtonNew
|
||||
|
||||
let
|
||||
fileBar :: FileBar
|
||||
fileBar = FileBar {..}
|
||||
|
|
|
|||
|
|
@ -273,21 +273,6 @@ createMenuBar uiElts@( UIElements { application, window, titleBar } ) vars colou
|
|||
widgetAddClasses menuBar [ "headerMenu", "text", "plain" ]
|
||||
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
|
||||
widgetAddClasses windowIcons [ "windowIcons" ]
|
||||
GTK.headerBarPackEnd titleBar windowIcons
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ module MetaBrush.UI.StrokeTreeView
|
|||
import Control.Arrow
|
||||
( second )
|
||||
import Control.Monad
|
||||
( unless, void )
|
||||
( void )
|
||||
import Data.Foldable
|
||||
( for_ )
|
||||
import Data.List
|
||||
|
|
@ -367,43 +367,6 @@ newLayerViewWidget = do
|
|||
|
||||
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
|
||||
-- the wdigets to display the appropriate content.
|
||||
getLayerViewWidget :: GTK.TreeExpander -> IO LayerViewWidget
|
||||
|
|
|
|||
Loading…
Reference in a new issue