module Manatee.Extension.Editor.SourceView where
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad
import Data.Map (Map)
import Data.Text.Lazy (Text)
import Data.Typeable
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Graphics.UI.Gtk.SourceView.SourceLanguage
import Graphics.UI.Gtk.SourceView.SourceLanguageManager
import Manatee.Core.DBus
import Manatee.Core.PageView
import Manatee.Core.Types
import Manatee.Extension.Editor.SourceBuffer
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.Gtk.Gtk
import Manatee.Toolkit.Gtk.Multiline
import Manatee.Toolkit.Gtk.ScrolledWindow
import Text.Printf
import qualified Data.Map as M
import qualified Graphics.UI.Gtk.SourceView.SourceBuffer as SB
import qualified Graphics.UI.Gtk.SourceView.SourceView as SV
data SourceView =
SourceView {sourceViewPlugId :: TVar PagePlugId
,sourceViewScrolledWindow :: ScrolledWindow
,sourceViewView :: SV.SourceView
,sourceViewBuffer :: SourceBuffer
}
deriving Typeable
instance PageBuffer SourceBuffer where
pageBufferGetName = readTVarIO . sourceBufferFilePath
pageBufferSetName a = writeTVarIO (sourceBufferFilePath a)
pageBufferClient = sourceBufferClient
pageBufferCreateView a pId = PageViewWrap <$> sourceViewNew a pId
pageBufferMode = sourceBufferMode
instance PageView SourceView where
pageViewBuffer = PageBufferWrap . sourceViewBuffer
pageViewPlugId = sourceViewPlugId
pageViewFocus = widgetGrabFocus . sourceViewView
pageViewCut = sourceViewCut
pageViewCopy = sourceViewCopy
pageViewPaste = sourceViewPaste
pageViewScrolledWindow = sourceViewScrolledWindow
pageViewHandleKeyAction = sourceViewHandleKeyAction
pageViewScrollToTop = sourceViewScrollToTop
pageViewScrollToBottom = sourceViewScrollToBottom
pageViewScrollVerticalPage = sourceViewScrollVerticalPage
pageViewScrollVerticalStep = sourceViewScrollVerticalStep
sourceViewNew :: SourceBuffer -> PagePlugId -> IO SourceView
sourceViewNew sb plugId = do
pId <- newTVarIO plugId
scrolledWindow <- scrolledWindowNew_
sourceView <- SV.sourceViewNewWithBuffer (sourceBufferBuffer sb)
scrolledWindow `containerAdd` sourceView
fontDescr <- fontDescriptionFromString "Monospace"
widgetModifyFont sourceView (Just fontDescr)
let sv = SourceView pId scrolledWindow sourceView sb
sourceViewSyntaxHighlight sv
SV.sourceViewSetHighlightCurrentLine sourceView True
SV.sourceViewSetInsertSpacesInsteadOfTabs sourceView True
SV.sourceViewSetShowLineNumbers sourceView True
textViewSetCursorVisible sourceView True
sourceViewHandlePositionDisplay sv
sourceViewHandleSelectionMark sv
return sv
sourceViewGetTextBuffer :: SourceView -> IO TextBuffer
sourceViewGetTextBuffer = textViewGetBuffer . sourceViewView
sourceViewGetSourceBuffer :: SourceView -> IO SB.SourceBuffer
sourceViewGetSourceBuffer sb =
SB.castToSourceBuffer <$> sourceViewGetTextBuffer sb
sourceViewGetText :: SourceView -> IO String
sourceViewGetText = textViewGetText . sourceViewView
sourceViewGetLine :: SourceView -> IO Int
sourceViewGetLine = textViewGetLine . sourceViewView
sourceViewGetColumn :: SourceView -> IO Int
sourceViewGetColumn = textViewGetColumn . sourceViewView
sourceViewDisplayPositionStatus :: SourceView -> IO ()
sourceViewDisplayPositionStatus sb =
liftM2 (printf "Pos (%d, %d)") (sourceViewGetLine sb) (sourceViewGetColumn sb)
>>= pageViewUpdateInfoStatus sb "Pos"
sourceViewHandlePositionDisplay :: SourceView -> IO ()
sourceViewHandlePositionDisplay sv = do
sourceViewView sv `afterExposeRect` (\_ -> sourceViewDisplayPositionStatus sv)
return ()
sourceViewHandleSelectionMark :: SourceView -> IO ()
sourceViewHandleSelectionMark sv = do
let sourceView = sourceViewView sv
onButtonPress sourceView (\_ -> textViewCancelSelectionMark sourceView >> return False)
buffer <- textViewGetBuffer sourceView
onBufferChanged buffer (textBufferUpdateSelectionIter buffer)
onFocusIn sourceView (\_ -> sourceViewApplySelectionMark sv >> return False)
return ()
sourceViewGetLanguage :: SourceView -> IO (Maybe SourceLanguage)
sourceViewGetLanguage buffer =
SB.sourceBufferGetLanguage
=<< sourceViewGetSourceBuffer buffer
sourceViewSetLanguage :: SourceView -> SourceLanguage -> IO ()
sourceViewSetLanguage buffer language =
(<=<) (`SB.sourceBufferSetLanguage` Just language) sourceViewGetSourceBuffer buffer
sourceViewSyntaxHighlight :: SourceView -> IO ()
sourceViewSyntaxHighlight view = do
lm <- sourceLanguageManagerNew
name <- sourceViewName view
(_, lang) <- sourceLanguageForFilename lm (Just name)
lang ?>= sourceViewSetLanguage view
sourceViewSave :: SourceView -> IO ()
sourceViewSave a = do
filepath <- sourceViewName a
string <- sourceViewGetText a
writeFile filepath string
name <- sourceViewName a
pageViewUpdateOutputStatus a ("Save " ++ name) Nothing
sourceViewName :: SourceView -> IO String
sourceViewName =
pageBufferGetName . sourceViewBuffer
sourceViewUndo :: SourceView -> IO ()
sourceViewUndo a = do
sb <- sourceViewGetSourceBuffer a
ifM (SB.sourceBufferGetCanUndo sb)
(do
SB.sourceBufferUndo sb
pageViewUpdateOutputStatus a "Undo!" Nothing)
(pageViewUpdateOutputStatus a "No further undo information." Nothing)
sourceViewRedo :: SourceView -> IO ()
sourceViewRedo a = do
sb <- sourceViewGetSourceBuffer a
ifM (SB.sourceBufferGetCanRedo sb)
(do
SB.sourceBufferRedo sb
pageViewUpdateOutputStatus a "Redo!" Nothing)
(pageViewUpdateOutputStatus a "No further redo information." Nothing)
sourceViewWrapAction :: SourceView -> IO () -> IO ()
sourceViewWrapAction = textViewWrapAction . sourceViewView
sourceViewNewline :: SourceView -> IO ()
sourceViewNewline = textViewNewLine . sourceViewView
sourceViewOpenNewlineBelow :: SourceView -> IO ()
sourceViewOpenNewlineBelow a =
textViewOpenNewlineBelow (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewOpenNewlineAbove :: SourceView -> IO ()
sourceViewOpenNewlineAbove a =
textViewOpenNewlineAbove (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewSelectAll :: SourceView -> IO ()
sourceViewSelectAll = textViewSelectAll . sourceViewView
sourceViewDelete :: SourceView -> IO ()
sourceViewDelete view =
textViewDelete (sourceViewView view) True True >> return ()
sourceViewCut :: SourceView -> IO Bool
sourceViewCut view = do
textViewCut $ sourceViewView view
return True
sourceViewCopy :: SourceView -> IO Bool
sourceViewCopy view = do
textViewCopy $ sourceViewView view
return True
sourceViewPaste :: SourceView -> IO Bool
sourceViewPaste view = do
textViewPaste $ sourceViewView view
return True
sourceViewForwardLine :: SourceView -> IO ()
sourceViewForwardLine a = do
textViewForwardLine (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewBackwardLine :: SourceView -> IO ()
sourceViewBackwardLine a = do
textViewBackwardLine (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewForwardChar :: SourceView -> IO ()
sourceViewForwardChar a = do
textViewForwardChar (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewBackwardChar :: SourceView -> IO ()
sourceViewBackwardChar a = do
textViewBackwardChar (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewForwardWord :: SourceView -> IO ()
sourceViewForwardWord a = do
textViewForwardWord (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewBackwardWord :: SourceView -> IO ()
sourceViewBackwardWord a = do
textViewBackwardWord (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewScrollToTop :: SourceView -> IO ()
sourceViewScrollToTop a = do
textViewBegin (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewScrollToBottom :: SourceView -> IO ()
sourceViewScrollToBottom a = do
textViewEnd (sourceViewView a) (sourceViewScrolledWindow a)
sourceViewApplySelectionMark a
sourceViewSmartHome :: SourceView -> IO ()
sourceViewSmartHome a = do
textViewSmartHome $ sourceViewView a
sourceViewApplySelectionMark a
sourceViewSmartEnd :: SourceView -> IO ()
sourceViewSmartEnd a = do
textViewSmartEnd $ sourceViewView a
sourceViewApplySelectionMark a
sourceViewDeleteForwardChar :: SourceView -> IO ()
sourceViewDeleteForwardChar view =
textViewDeleteForwardChar (sourceViewView view) False >> return ()
sourceViewDeleteBackwardChar :: SourceView -> IO ()
sourceViewDeleteBackwardChar view =
textViewDeleteBackwardChar (sourceViewView view) False >> return ()
sourceViewDeleteForwardWord :: SourceView -> IO ()
sourceViewDeleteForwardWord view =
textViewDeleteForwardWord (sourceViewView view) False >> return ()
sourceViewDeleteBackwardWord :: SourceView -> IO ()
sourceViewDeleteBackwardWord view =
textViewDeleteBackwardWord (sourceViewView view) False >> return ()
sourceViewDeleteToLineEnd :: SourceView -> IO ()
sourceViewDeleteToLineEnd view =
textViewDeleteToLineEnd (sourceViewView view) False >> return ()
sourceViewDeleteToLineStart :: SourceView -> IO ()
sourceViewDeleteToLineStart view =
textViewDeleteToLineStart (sourceViewView view) False >> return ()
sourceViewDupLinesBelow, sourceViewDupLinesAbove :: SourceView -> IO ()
sourceViewDupLinesBelow = textViewDupLinesBelow . sourceViewView
sourceViewDupLinesAbove = textViewDupLinesAbove . sourceViewView
sourceViewDelLines :: SourceView -> IO ()
sourceViewDelLines view =
textViewDelLines (sourceViewView view) >> return ()
sourceViewTraLinesBelow, sourceViewTraLinesAbove :: SourceView -> IO ()
sourceViewTraLinesBelow = textViewTraLinesBelow . sourceViewView
sourceViewTraLinesAbove = textViewTraLinesAbove . sourceViewView
sourceViewReload :: SourceView -> IO ()
sourceViewReload sv = do
name <- sourceViewName sv
textViewLoadFile (sourceViewView sv) name
sourceViewScrollToTop sv
sourceViewSetText :: SourceView -> String -> IO ()
sourceViewSetText = textViewSetText . sourceViewView
sourceViewKeymap :: Map Text (SourceView -> IO ())
sourceViewKeymap =
M.fromList
[("M-a", sourceViewSelectAll)
,("M-s", sourceViewSave)
,("M-d", sourceViewDelLines)
,("M-D", sourceViewDelete)
,("M-/", sourceViewUndo)
,("M-?", sourceViewRedo)
,("M-r", sourceViewReload)
,("M-,", sourceViewDeleteBackwardChar)
,("M-.", sourceViewDeleteForwardChar)
,("M-<", sourceViewDeleteBackwardWord)
,("M->", sourceViewDeleteForwardWord)
,("M-C-,", sourceViewDeleteToLineStart)
,("M-C-.", sourceViewDeleteToLineEnd)
,("M-j", sourceViewForwardLine)
,("M-k", sourceViewBackwardLine)
,("M-l", sourceViewForwardChar)
,("M-h", sourceViewBackwardChar)
,("M-m", sourceViewNewline)
,("Down", sourceViewForwardLine)
,("Up", sourceViewBackwardLine)
,("Left", sourceViewForwardChar)
,("Right", sourceViewBackwardChar)
,("Return", sourceViewNewline)
,("M-L", sourceViewForwardWord)
,("M-H", sourceViewBackwardWord)
,("M-P-h", sourceViewSmartHome)
,("M-P-l", sourceViewSmartEnd)
,("M-N", sourceViewOpenNewlineBelow)
,("M-P", sourceViewOpenNewlineAbove)
,("M-w", sourceViewDupLinesBelow)
,("M-W", sourceViewDupLinesAbove)
,("M-e", sourceViewTraLinesBelow)
,("M-E", sourceViewTraLinesAbove)
,("C-c", sourceViewToggleSelectionMark)
,("C-C", sourceViewExchangeSelectionMark)
,("C-o", sourceViewOpenFile)
,("C-g", sourceViewGotoLine)
,("C-G", sourceViewGotoColumn)
]
sourceViewOpenFile :: SourceView -> IO ()
sourceViewOpenFile view =
localInteractive view "fOpen file : " $ \ [path] ->
mkDaemonSignal (pageViewClient view) NewTab (NewTabArgs "PageEditor" path)
sourceViewGotoColumn :: SourceView -> IO ()
sourceViewGotoColumn view@SourceView {sourceViewView = sourceView} =
localInteractive view "nColumn : " $ \ [column] -> do
let number = read column :: Int
textViewGotoColumn sourceView number
sourceViewGotoLine :: SourceView -> IO ()
sourceViewGotoLine view@SourceView {sourceViewView = sourceView} =
localInteractive view "nLine : " $ \ [line] -> do
let number = read line :: Int
textViewGotoLine sourceView number
sourceViewToggleSelectionMark :: SourceView -> IO ()
sourceViewToggleSelectionMark = textViewToggleSelectionMark . sourceViewView
sourceViewExchangeSelectionMark :: SourceView -> IO ()
sourceViewExchangeSelectionMark = textViewExchangeSelectionMark . sourceViewView
sourceViewApplySelectionMark :: SourceView -> IO ()
sourceViewApplySelectionMark = textViewApplySelectionMark . sourceViewView
sourceViewScrollVerticalPage :: Bool -> SourceView -> IO ()
sourceViewScrollVerticalPage isDown a = do
let sw = sourceViewScrolledWindow a
tv = sourceViewView a
pageInc <- (<=<) adjustmentGetPageIncrement scrolledWindowGetVAdjustment sw
textViewScrollVertical tv sw (if isDown then pageInc else ( pageInc))
sourceViewApplySelectionMark a
sourceViewScrollVerticalStep :: Bool -> SourceView -> IO ()
sourceViewScrollVerticalStep isDown a = do
let sw = sourceViewScrolledWindow a
tv = sourceViewView a
ti <- textViewGetTextIter tv
(_, lineHeight) <- textViewGetLineYrange tv ti
let stepInc = integralToDouble lineHeight
textViewScrollVertical tv sw (if isDown then stepInc else ( stepInc))
sourceViewApplySelectionMark a
sourceViewHandleKeyAction :: SourceView -> Text -> SerializedEvent -> IO ()
sourceViewHandleKeyAction view keystoke sEvent =
case M.lookup keystoke sourceViewKeymap of
Just action -> action view
Nothing -> widgetPropagateEvent (sourceViewView view) sEvent