module Hob.Ui (loadGui, getActiveEditorText, getActiveEditorTab, getEditorText, getActiveEditor) where import Control.Monad.Reader import Data.Char (intToDigit) import Data.IORef import Data.List (intercalate) import Data.Monoid (mconcat) import Data.Text (unpack) import Graphics.UI.Gtk import Graphics.UI.Gtk.General.CssProvider import qualified Graphics.UI.Gtk.General.StyleContext as GtkSc import GtkExtras.LargeTreeStore as LTS import Hob.Command.CloseCurrentTab import Hob.Command.FindText import Hob.Command.FocusCommandEntry import Hob.Command.FocusNextTab import Hob.Command.FocusNumberedTab import Hob.Command.FocusPreviousTab import Hob.Command.FocusSidebar import Hob.Command.NewTab import Hob.Command.ReloadSidebarTree import Hob.Command.ReplaceText import Hob.Command.SaveCurrentTab import Hob.Context import Hob.Context.FileContext import Hob.Context.StyleContext import Hob.Context.UiContext import Hob.Ui.CommandEntry import Hob.Ui.Editor import Hob.Ui.Sidebar import Hob.Ui.SidebarSearch loadGui :: FileContext -> StyleContext -> IO Context loadGui fileCtx styleCtx = do _ <- initGUI builder <- loadUiBuilder setGtkStyle styleCtx ctx <- initCtx builder defaultCommands initMainWindow ctx initEditingArea ctx initSidebar ctx initCommandEntry ctx initActiveModesMonitor ctx return ctx where initCtx builder initCommands = do window <- builderGetObject builder castToWindow "mainWindow" notebook <- builderGetObject builder castToNotebook "tabbedEditArea" cmdEntry <- builderGetObject builder castToEntry "command" treeView <- builderGetObject builder castToTreeView "directoryListing" treeViewSearch <- builderGetObject builder castToEntry "directoryListingSearch" activeModesObject <- builderGetObject builder castToLabel "activeMode" treeModel <- LTS.treeStoreNew [] let uiCtx = UiContext window notebook cmdEntry treeView treeViewSearch activeModesObject initContext styleCtx fileCtx uiCtx treeModel initCommands loadUiBuilder = do builder <- builderNew builderAddFromFile builder $ uiFile styleCtx return builder initSidebar ctx = do let treeView = sidebarTree . uiContext $ ctx let treeViewSearch = sidebarTreeSearch . uiContext $ ctx widgetSetName treeView "directoryListing" widgetSetName treeViewSearch "sidebarSearchEntry" let mainEditNotebook = mainNotebook . uiContext $ ctx newSideBarFileTree ctx treeView $ launchNewFileEditor ctx mainEditNotebook newSideBarFileTreeSearch ctx initCommandEntry ctx = do let cmdEntry = commandEntry . uiContext $ ctx widgetSetName cmdEntry "commandEntry" deferredRunner ctx $ newCommandEntry cmdEntry initMainWindow ctx = do let window = mainWindow . uiContext $ ctx lastPressedKeyRef <- newIORef "" widgetSetName window "mainWindow" _ <- window `on` keyPressEvent $ do modifier <- eventModifier keyT <- eventKeyName let key = unpack keyT liftIO $ writeIORef lastPressedKeyRef key if key == "Control_L" then return False else invokeKeyCommand ctx (modifier, key) _ <- window `on` keyReleaseEvent $ do modifier <- eventModifier keyT <- eventKeyName lastPressedKey <- liftIO $ readIORef lastPressedKeyRef let key = unpack keyT if (lastPressedKey == key) && (key == "Control_L") then invokeKeyCommand ctx (modifier, key) else return False return () initEditingArea ctx = do let mainEditNotebook = mainNotebook . uiContext $ ctx _ <- mainEditNotebook `on` switchPage $ const $ deferredRunner ctx (emitEvent $ Event "core.editor.focused") return () invokeKeyCommand ctx command = liftIO . runApp ctx $ do activeCommands <- getActiveCommands maybe (return False) (\cmd -> commandExecute cmd >> return True) $ matchKeyBinding activeCommands command initActiveModesMonitor ctx = deferredRunner ctx $ do registerEventHandler (Event "core.editor.focused") refreshModesLabel registerEventHandler (Event "core.mode.change") refreshModesLabel refreshModesLabel = do activeCtx <- ask modes <- activeModes let modesUi = activeModesLabel . uiContext $ activeCtx let modesToString = intercalate " | " . filter (not . null) . map modeName liftIO $ labelSetText modesUi $ maybe "-" modesToString modes defaultCommands = mconcat $ [ createMatcherForKeyBinding ([Control], "w") closeCurrentEditorTab, createMatcherForKeyBinding ([Control], "s") saveCurrentEditorTab, createMatcherForKeyBinding ([Control], "n") editNewFileCommandHandler, createMatcherForKeyBinding ([Control], "r") reloadSidebarTreeCommandHandler, createMatcherForKeyBinding ([Control], "Tab") focusNextTabCommandHandler, createMatcherForKeyBinding ([Shift, Control], "Tab") focusPreviousTabCommandHandler, createMatcherForKeyBinding ([Shift, Control], "ISO_Left_Tab") focusPreviousTabCommandHandler, createMatcherForKeyBinding ([Control], "t") focusSidebarCommandHandler, createMatcherForKeyBinding ([Shift, Control], "T") syncFocusSidebarCommandHandler, createMatcherForPrefix "/" searchCommandHandler, createMatcherForReplace 's' replaceCommandHandler, createMatcherForKeyBinding ([Control], "Control_L") focusCommandEntryCommandHandler, createMatcherForKeyBinding ([], "Escape") focusActiveEditorAndExitLastModeCommandHandler ] ++ [ createMatcherForKeyBinding ([Control], [intToDigit $ (position + 1) `mod` 10]) $ focusNumberedTabCommandHandler position | position <- [0..9] ] setGtkStyle :: StyleContext -> IO () setGtkStyle styleCtx = do cssProvider <- cssProviderNew cssProviderLoadFromPath cssProvider $ uiTheme styleCtx maybe (return()) (\screen -> GtkSc.styleContextAddProviderForScreen screen cssProvider 800) =<< screenGetDefault