module Hob.Context ( App, Context(..), PreviewCommandHandler(..), CommandHandler(..), CommandMatcher(..), KeyboardBinding, KeyCommandMatcher, TextCommandMatcher, Mode(..), Event(..), Editor(..), EditorList(..), initContext, runOnEditor, enterMode, exitLastMode, activeModes, deferredRunner, registerEventHandler, emitEvent, createMatcherForPrefix, createMatcherForCommand, createMatcherForKeyBinding, fromContext, runApp, getActiveCommands, ) where import Control.Concurrent.MVar import Control.Monad.Reader import Graphics.UI.Gtk (postGUIAsync) import GtkExtras.LargeTreeStore as LTS (TreeStore) import Hob.Context.CommandMatcher import Hob.Context.Editor import Hob.Context.Events import Hob.Context.FileContext import Hob.Context.StyleContext import Hob.Context.Types import Hob.Context.UiContext import Hob.DirectoryTree initContext :: StyleContext -> FileContext -> UiContext -> LTS.TreeStore DirectoryTreeElement -> CommandMatcher -> IO Context initContext styleCtx fileCtx uiCtx treeModel initCommands = do actionSync <- newMVar True deferredMessagesRef <- newMVar [] bus <- initEventBus editorList <- initEditors initialisedIdGenerator <- initIdGenerator let ctx = Context styleCtx fileCtx uiCtx treeModel initCommands editorList (messageRunner actionSync deferredMessagesRef) bus initialisedIdGenerator return ctx where messageRunner actionSync deferredMessagesRef ctx message = do queueMessage deferredMessagesRef message sync <- tryTakeMVar actionSync case sync of Just _ -> flushMessageQueue deferredMessagesRef ctx >> putMVar actionSync True Nothing -> return() flushMessageQueue deferredMessagesRef ctx = do messages <- swapMVar deferredMessagesRef [] unless (null messages) $ foldM runMessage ctx messages >>= flushMessageQueue deferredMessagesRef queueMessage deferredMessagesRef message = modifyMVar_ deferredMessagesRef (\messages -> return $ messages ++ [message]) runApp :: Context -> App a -> IO a runApp ctx appSteps = runReaderT appSteps ctx runMessage :: Context -> Message -> IO Context runMessage ctx (AppAction action) = runApp ctx action >> return ctx deferredRunner :: Context -> App() -> IO() deferredRunner ctx actions = postGUIAsync $ messageLoop ctx ctx $ AppAction actions initIdGenerator :: IO (IO Int) initIdGenerator = do generatorStorage <- newMVar 0 return $ do lastGeneratdId <- takeMVar generatorStorage let newId = lastGeneratdId + 1 putMVar generatorStorage newId return newId